精华内容
下载资源
问答
  • ※ 下面问题本人也在网上找了很久答案,可是均不行,希望各位看官能帮帮忙。谢谢。 其中 i 找了win32返回值为字符串win32 apiVBA接口调用 =》 测试成功,方法这里...//那么请问 : 在VBA中怎么调用这个接口
  • '===============================...' VBA采用Application.OnTime实现计时器 ' ' http://www.cnhup.com '================================ Public RunWhen As Double Public Const cRunIntervalSeconds = 120...
    '================================
    ' VBA采用Application.OnTime实现计时器
    '
    ' http://www.cnhup.com
    '================================
    Public RunWhen As Double
    Public Const cRunIntervalSeconds = 120 ' two minutes
    Public Const cRunWhat = "TheSub"  ' the name of the procedure to run
    Sub StartTimer()
        RunWhen = Now + TimeSerial(0,0,cRunIntervalSeconds)
        Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
            Schedule:=True
    End Sub
    Sub TheSub()
        StartTimer  ' Reschedule the procedure
    End Sub
    Sub StopTimer()
        On Error Resume Next
        Application.OnTime EarliestTime:=RunWhen,Procedure:=cRunWhat, _
            Schedule:=False
    End Sub
    '================================
    ' VBA采用Windows API实现计时器
    '
    ' http://www.cnhup.com
    '================================
    Public Declare Function SetTimer Lib "user32" ( _
        ByVal HWnd As Long, _
        ByVal nIDEvent As Long, _
        ByVal uElapse As Long, _ 
        ByVal lpTimerFunc As Long) As Long
    
    Public Declare Function KillTimer Lib "user32" ( _
        ByVal HWnd As Long, _
        ByVal nIDEvent As Long) As Long
    
    Public TimerID As Long
    Public TimerSeconds As Single
    
    Sub StartTimer()
        TimerSeconds = 1 ' how often to "pop" the timer.
        TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
    End Sub
    
    Sub EndTimer()
        On Error Resume Next
        KillTimer 0&, TimerID
    End Sub
    
    Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, _
            ByVal nIDEvent As Long, ByVal dwTimer As Long)
        
        ''''''
        ' This procedure is called by Windows. Put your
        ' code here.
        ''''''
    End Sub

     

    转载于:https://www.cnblogs.com/damowang/p/6121910.html

    展开全文
  • excel2016 64bit的vba中使用API函数RegisterClass注册窗体类就Excel就崩溃!请问是怎么回事? ``` Option Explicit Public Declare PtrSafe Function RegisterClass Lib "user32" Alias "RegisterClassA" ...
  • Excel VBA中如何支持复数计算?

    千次阅读 2016-06-08 20:38:56
    内置built-inWorkSheetFunction还是VBA函数都不支持复数类型。转一个Option Explicit Const pi = 3.14159265358979Type Complex re As Double im As Double End TypePublic Function AddComplex(a As Complex, b...

    答案居然是需要自己定义复数计算。

    内置built-in的WorkSheetFunction还是VBA函数都不支持复数类型。

    转一个

    Option Explicit
    Const pi = 3.14159265358979
    
    Type Complex
      re As Double
      im As Double
    End Type
    
    Public Function AddComplex(a As Complex, b As Complex) As Complex
      AddComplex.re = a.re + b.re
      AddComplex.im = a.im + b.im
    End Function
    
    Public Function MultiplyComplex(a As Complex, b As Complex) As Complex
      MultiplyComplex.re = a.re * b.re - a.im * b.im
      MultiplyComplex.im = a.re * b.im + a.im * b.re
    End Function
    
    Public Function Conjugate(a As Complex) As Complex
      Conjugate.re = a.re
      Conjugate.im = -a.im
    End Function
    
    Public Function Modulo(a As Complex) As Double
      Modulo = Sqr(a.re ^ 2 + a.im ^ 2)
    End Function
    
    Public Function Argument(a As Complex) As Double
      Dim i As Integer
      Dim v(1 To 4) As Double
      If (z.re = 0) And (z.im = 0) Then
        Argument = -10
        'End Function
      End If
    
    v(1) = ArcSin(z.im / Modulo(z))
    v(2) = mcPI - v(1)
    
    v(3) = ArcCos(z.re / Modulo(z))
    v(4) = -1 * v(3)
    
    For i = 1 To 4
    
    While v(i) > mcPI
    v(i) = v(i) - 2 * mcPI
    Wend
    
    While v(i) < mcPI
    v(i) = v(i) + 2 * mcPI
    Wend
    
    Next i
    
    If v(1) = v(3) Then Argument = v(1)
    If v(2) = v(3) Then Argument = v(2)
    
    If v(1) = v(4) Then Argument = v(1)
    If v(2) = v(4) Then Argument = v(2)
    
    End Function
    
    ' Code by : Steven Roland Bazinet (ArcSin function only)
    
    Private Function ArcSin(vntSine As Variant) As Double
    On Error GoTo ERROR_ArcSine
    
    Const cOVERFLOW = 6
    
    Dim blnEditPassed As Boolean
    Dim dblTemp As Double
    
    blnEditPassed = False
    If IsNumeric(vntSine) Then
    If vntSine >= -1 And vntSine <= 1 Then
    blnEditPassed = True
    
    dblTemp = Sqr(-vntSine * vntSine + 1)
    If dblTemp = 0 Then
    ArcSin = Sgn(vntSine) * pi / 2
    Else
    ArcSin = Atn(vntSine / dblTemp)
    End If
    End If
    End If
    
    EXIT__ArcSine:
    If Not blnEditPassed Then Err.Raise cOVERFLOW
    Exit Function
    
    ERROR_ArcSine:
    On Error GoTo 0
    blnEditPassed = False
    Resume EXIT__ArcSine
    
    End Function
    
    ' Code by : PaperCut, based (very much!) on Steven R Bazinet's code
    
    Private Function ArcCos(vntcos As Variant) As Double
    On Error GoTo ERROR_ArcSine
    
    Const cOVERFLOW = 6
    
    Dim blnEditPassed As Boolean
    Dim dblTemp As Double
    
    blnEditPassed = False
    If IsNumeric(vntcos) Then
    If vntcos >= -1 And vntcos <= 1 Then
    blnEditPassed = True
    
    dblTemp = Sqr(-vntcos * vntcos + 1)
    If dblTemp = 0 Then
    ArcCos = Sgn(vntcos) * pi / 2
    Else
    ArcCos = Atn(dblTemp / vntcos)
    End If
    End If
    End If
    
    EXIT__ArcCos:
    If Not blnEditPassed Then Err.Raise cOVERFLOW
    Exit Function
    
    ERROR_ArcCos:
    On Error GoTo 0
    blnEditPassed = False
    Resume EXIT__ArcSine
    
    End Function 
    展开全文
  • VB VBA ASP 可通用基于Base64进行加密和解密函数可用于Access VBA 以及 Excel VBA对字符串 数据甚至文本文件进行加密和解密,以保证您数据安全。先创建一个模块,在模块添加如下代码OPTION EXPLICITconst ...

    VB VBA ASP 可通用的基于Base64进行加密和解密的函数

    可用于Access VBA 以及 Excel VBA对字符串 数据甚至文本文件进行加密和解密,以保证您数据的安全。

    先创建一个模块,在模块中添加如下代码

    OPTION EXPLICIT

    const BASE_64_MAP_INIT = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

    dim newline

    dim Base64EncMap(63)

    dim Base64DecMap(127)

    '初始化函数

    PUBLIC SUB initCodecs()

    ' 初始化变量

    newline =vbCrlf ' 如果是ASP就改成这个 "

    " & chr(13) & chr(10)

    dim max, idx

    max = len(BASE_64_MAP_INIT)

    for idx = 0 to max - 1

    Base64EncMap(idx) = mid(BASE_64_MAP_INIT, idx + 1, 1)

    next

    for idx = 0 to max - 1

    Base64DecMap(ASC(Base64EncMap(idx))) = idx

    next

    END SUB

    'Base64加密函数

    PUBLIC FUNCTION base64Encode(plain)

    if len(plain) = 0 then

    base64Encode = ""

    exit function

    end if

    dim ret, ndx, by3, first, second, third

    by3 = (len(plain) \ 3) * 3

    ndx = 1

    do while ndx <= by3

    first = asc(mid(plain, ndx+0, 1))

    second = asc(mid(plain, ndx+1, 1))

    third = asc(mid(plain, ndx+2, 1))

    ret = ret & Base64EncMap( (first \ 4) AND 63 )

    ret = ret & Base64EncMap( ((first * 16) AND 48) + ((second \ 16) AND 15 ) )

    ret = ret & Base64EncMap( ((second * 4) AND 60) + ((third \ 64) AND 3 ) )

    ret = ret & Base64EncMap( third AND 63)

    ndx = ndx + 3

    loop

    if by3 < len(plain) then

    first = asc(mid(plain, ndx+0, 1))

    ret = ret & Base64EncMap( (first \ 4) AND 63 )

    if (len(plain) MOD 3 ) = 2 then

    second = asc(mid(plain, ndx+1, 1))

    ret = ret & Base64EncMap( ((first * 16) AND 48) + ((second \ 16) AND 15 ) )

    ret = ret & Base64EncMap( ((second * 4) AND 60) )

    else

    ret = ret & Base64EncMap( (first * 16) AND 48)

    ret = ret '& "="

    end if

    ret = ret '& "="

    end if

    base64Encode = ret

    END FUNCTION

    'Base64解密函数

    PUBLIC FUNCTION base64Decode(scrambled)

    if len(scrambled) = 0 then

    base64Decode = ""

    exit function

    end if

    dim realLen

    realLen = len(scrambled)

    do while mid(scrambled, realLen, 1) = "="

    realLen = realLen - 1

    loop

    dim ret, ndx, by4, first, second, third, fourth

    ret = ""

    by4 = (realLen \ 4) * 4

    ndx = 1

    do while ndx <= by4

    first = Base64DecMap(asc(mid(scrambled, ndx+0, 1)))

    second = Base64DecMap(asc(mid(scrambled, ndx+1, 1)))

    third = Base64DecMap(asc(mid(scrambled, ndx+2, 1)))

    fourth = Base64DecMap(asc(mid(scrambled, ndx+3, 1)))

    ret = ret & chr( ((first * 4) AND 255) + ((second \ 16) AND 3))

    ret = ret & chr( ((second * 16) AND 255) + ((third \ 4) AND 15))

    ret = ret & chr( ((third * 64) AND 255) + (fourth AND 63))

    ndx = ndx + 4

    loop

    if ndx < realLen then

    first = Base64DecMap(asc(mid(scrambled, ndx+0, 1)))

    second = Base64DecMap(asc(mid(scrambled, ndx+1, 1)))

    ret = ret & chr( ((first * 4) AND 255) + ((second \ 16) AND 3))

    if realLen MOD 4 = 3 then

    third = Base64DecMap(asc(mid(scrambled,ndx+2,1)))

    ret = ret & chr( ((second * 16) AND 255) + ((third \ 4) AND 15))

    end if

    end if

    base64Decode = ret

    END FUNCTION

    ' 初始化

    call initCodecs

    ' 测试代码

    dim inp, encode

    inp = "1234567890"

    encode = base64Encode(inp)

    Debug.Print "加密前为:" & inp & vbCrlf

    Debug.Print "加密后为:" & encode & vbCrlf

    Debug.Print "解密后为:" & base64Decode(encode) & vbCrlf

    展开全文
  • 强制声明变量 Option Explicit 说明该语句必在任何过程之前出现在模块 声明常数 用来代替文字值 Const 常数默认状态是 Private Const My = 456 ' 声明 Public 常数 Public Const MyString = "HELP" ' 声明 ...
  • Module1的VBA模块    名为Module1的VBA模块包含了一些声明信息、一...Module1 VBA模块中的声明信息    以下是在Module1 VBA模块顶部的声明信息:   Public Const APPNAME As String = “Text ToolsUtility” Publ

    Module1的VBA模块

     

            名为Module1的VBA模块包含了一些声明信息、一个执行功能的简单过程和一个处理撤销操作的过程。

     

    Module1 VBA模块中的声明信息

     

            以下是在Module1 VBA模块顶部的声明信息:

     

     

            首行代码声明了一个公有的字符型常量,用于存储应用程序的名称。这个字符串被用在UserForm的标题属性信息中和其他消息框中。

     

            PROGRESSTHRESHOLD常量则是指定了单元格的数量。这个常量将用于控制进度条指示器的显示。由于该常量的值设定为2000,所以当功能工作在2000或2000以上单元格时,进度条指示器则会被显示。

     

            UserChoices数组用于保存每个控件的值。当用户关闭对话框时,这个信息会被存储在Windows注册表里。当程序再次执行时,该信息会被读取出来。我增加了这个方便用户的特性是因为我发现许多用户每次使用功能时都执行着同样的操作。

     

            另外两个Range对象变量则是用于存储撤销操作的信息。

     

    Module1 VBA模块中的ShowTextToolsDialog过程

     

            以下是ShowTextToolsDialog过程代码:

     

     

            该过程首先检查了Excel的版本。如果版本低于Excel2007,则用户将会被告知该功能程序需要Excel2007版本或更高级的版本。

     

    注意

            为了方便,我写的这段功能代码只能运行在Excel2007版本或更高版本中。然而,你可以自己设计这个功能,让这个功能不仅可以运行在Excel2007版本或更高版本中,也可以在旧的Excel版本中运行。

     

            如果用户运行合适的Excel版本,那么ShowTextToolsDialog过程会检查以便确定表格是否处于有效状态,然后再检查该表格是否是工作表格。如果任何一个上述条件检查失败了,则InvalidContext变量会被赋值为True. 接下来的If-Then-Else条件判断结构检查InvalidContext变量以便抉择是显示一个消息对话框(如图14-4)还是显示UserForm1。Show方法使用vbModeless作为它的参数。这个参数决定了UserForm1为一个无模式的UserForm,换句话说,当这个无模式的UserForm1被显示时,用户可以保持在Excel中继续工作。



    图14-4:如果没有工作簿处于有效状态或有效的表格并不是一个工作表,则消息对话框会显示。

     

            请注意上述代码并不保证已选中某个范围的单元格。当Apply按钮被点击时,Apply按钮点击事件中会处理这种异常。

     

    建议:

             当我在开发这个功能时,因为我将Ribbon修改任务延后处理并且我需要一种方法来测试这个功能,所以我为ShowTextToolsDialog过程设置了键盘快捷键(Ctrl+Shift+T)。在我添加了Ribbon按钮后,我就移除了这个键盘快捷键。

     

            在宏中设置键盘快捷键,需要按Alt+F8来显示宏对话框。在Macro Name(宏名)框中键入ShowTextToolsDialog并点击Options(选项)。使用MacroOptions(宏选项)对话框来分配或解除快捷键的定义。

     

    Module1 VBA模块中的UndoTextTools过程

     

            当用户点击Undo(撤销)按钮或按下Ctrl+Z快捷键时,UndoTextTools过程会被执行。这个技术会在本章的后续章节中说明(见“实现撤销”)。

     

    UserForm1代码模块

     

            在UserForm1的代码模块中,全部的工作均由VBA代码处理。在这里,我简单地描述这个模块中的每个过程。代码很长,不便在这里一一列出,你可以打开tools.xlam文件来浏览代码,这个文件可在本书的网站上找到。

     

    UserForm1代码模块中的UserForm_Initialize过程

     

            在UserForm被显示之前,UserForm_Initialize过程就会被执行。此过程规范了UserForm的高度与宽度并且会从Windows注册表中获取之前控件的数据。此过程还为ComboBox(在代码中名为ComboBoxOperation)添加了多个列表对象。ComboBox决定了哪个操作将会被执行。这些列表对象为

     

    ➤ Changecase“改变大小写”

    ➤ Addtext“添加文本”

    ➤ Removeby position“根据位置移除”

    ➤ Removespaces“移除所有空格”

    ➤ Deletecharacters“删除字符”

     

    UserForm1代码模块中的ComboBoxOperation_Change过程

     

            每当用户选择了ComboBoxOperation中的某一列表对象,ComboBoxOperation_Change过程就会被执行。它用于显示或隐藏其他控件。例如,当用户选择了“改变大小写”选项,程序就会显示第二个ComboBox控件(名为ComboProc1),并且程序会为该控件增加以下选项:

     

    ➤ UPPERCASE“全部大写”

    ➤ lowercase“全部小写”

    ➤ ProperCase“单词首字母大写”

    ➤ Sentencecase“句首单词首字母大写”

    ➤ tOGGLEcASE“单词首字母小写,其余大写”

     

    UserForm1代码模块中的ApplyButton_Click过程

     

            当Apply按钮被点击时,ApplyButton_Click过程会被执行。这个过程会做一些异常检查以便确保已选定某一范围的单元格,接着会调用CreateWorkRange函数来确定将被处理的单元格中不存在空值的单元格。见接下来的一节“让文本工具功能变得更有效”。

     

            ApplyButton_Click过程也会调用SaveForUndo过程。SaveForUndo过程保存着当前数据以便用户撤销操作。见本章的后续章节“实现撤销”。

     

            然后,本过程会使用一个Select Case结构来调用合适的过程来完成这项操作。它会调用以下子过程之一:(以下为过程名称,不可翻译)

     

    ➤ ChangeCase

    ➤ AddText

    ➤ RemoveText

    ➤ RemoveSpaces

    ➤ RemoveCharacters

     

            其中的某些过程会调用其他函数过程。例如,ChangeCase过程会调用ToggleCase或SentenceCase过程。

     

    UserForm1代码模块中的CloseButton_Click过程

     

            当Close按钮被点击时,CloseButton_Click过程会被执行。该过程将当前控件的数据保存到Windows注册表中,然后卸载UserForm。

     

    UserForm1代码模块中的HelpButton_Click过程

     

            当Help按钮被点击时,HelpButton_Click过程会被执行。此过程简单显示了一个标准编译的HTML帮助文件。

     


    展开全文
  • 学习Excel技术,关注微信公众号:excelperfect在上一篇文章《基础扩展| 22. 遍历二叉树—前序遍历算法的VBA代码解析》,我们给出了前序遍历二叉树... 建立二叉树创建二叉树,代码如下:Const MAXSIZE = 100T...
  • Microsoft Word对宏定义为:“宏就是能组织到一起作为一独立命令使用一系列word命令,它能使日常工作变得更容易”。Word使用宏语言Visual Basic将宏作为一系列指令来编写。 计算机科学里宏是一种抽象,...
  • 学习Excel技术,关注微信公众号:excelperfect在上一篇文章《基础扩展| 21. 遍历二叉树》,我们给出了遍历二叉树三种方式:前序遍历、中序遍历、... 建立二叉树创建二叉树,代码如下:Const MAXSIZE = 100Ty...
  • VBA通过CDO发送邮件

    千次阅读 2016-01-29 14:00:18
    VBA中发送邮件有很多方法,Jmail或者直接调用outlook,Jmail要求本机安装Jmail.dll库文件,调用outlook又要要求本机安装outlook并且配置好outlook收发邮件。 本文介绍使用Windows自带cdosys.dll发送邮件。 不做...
  • 项目案例项目遇到一项任务:禁止文件名含有中文字符、空格等非法字符文件,在circleci持续整合进行排查。那思路很简单呢,用中文字符正则表达式去检查项目下文件路径就好了不是吗?那这样我们写出代码是:...
  • >Macros定义tt()Sub tt()Const strFolder As String = "D:/shp" Const strName As String = "MyShapeFile" 不要加Shp后缀 Const strShapeFieldName As String = "Shape" 打开用来放置ShapeFile文件目录作为一...
  • VBA】常用编程技巧个人总结

    千次阅读 2018-12-26 17:09:27
    FORM常用控件操作 对象操作【Book,Sheet,Cells】 调试方法 其他补充 VBA开发模式打开 语法操作 常量定义方法 Public Const PI As Double = 3.1415926535 字符和数值,Val函数,以及Format通用格式化...
  • vba实现文件内容汇总

    2019-06-10 20:32:46
    本功能主要实现将同一个文件夹相似Excel文件里内容汇总到同一个EXCEL文件。 2.代码实现 Sub ボタン3_Click() Dim dstSheet As Worksheet Set dstSheet = ThisWorkbook.Worksheets(1) Const Path As ...
  • 常量声明方法如下:Const 常量名称 As 数据类型 = 存储在常量中的数据 例如:Const PI As Single = 3.14 ' 定义一个浮点常量为PI,值为3.14变量声明方法如下:Dim 变量名 As 数据类型变量名,必须以字母或汉字开头,...
  • 常量声明方法如下:Const 常量名称 As 数据类型 = 存储在常量中的数据 例如:Const PI As Single = 3.14 ' 定义一个浮点常量为PI,值为3.14变量声明方法如下:Dim 变量名 As 数据类型变量名,必须以字母或汉字开头,...
  • 解决问题根本在于:将SQL多条批量语句存放到某个*.SQL文件,然后,通过VBA来调用该文件运行,这样就能解决问题了。以下SQL文件为E:\Mysql.sql。Const ForReading = 1, ForWriting = 2, ForAppend...
  • 自动生成VBA窗体菜单

    2010-08-16 15:23:46
    自动生成VBA窗体菜单 '*************************** '* 菜单类 * '*************************** Option Explicit Private WithEvents MenuBar_MenuItem As MSForms.Label '菜单项 Private WithEvents WorkForm As...
  • 下面程序,分别利用函数还有API来递归查找特定字符 ,并且将查找到行数输出到Excel。总体来说,利用API速度较快。 Option ExplicitAPI constantsPublic Const MAX_PATH = 260Public Const INVALID_HANDLE_...
  • ExcelVBA编程系列之数据类型(1):常量

    千次阅读 2011-07-17 22:19:14
    常量,也称常数,在程序过程中其值保持不变。常数可以是字符串、数值、另一常数、任何(除乘幂与Is之外的)算术运算符或逻辑运算符的组合...定义常量使程序设计变得更简单,可在代码中的任何地方使用常数代替实际的值或字
  • 除了@RolandSmith所写,这里还有一种在Excel-VBA中使用正则表达式方法Option ExplicitFunction ExtractSpecial(S As String, Index As Long) As StringDim RE As Object, MC As ObjectConst sPat As String = "...
  • 今天参考一个外文代码写: (作者:Steve McMahon steve@... 网址: http://www.shitalshah.com/vbxlr/tips/vba0035.htm) Private Const LF_FACESIZE = 32Private Const FW_NORMAL = 400Private Const...
  • RANSAC - 在散乱寻找规则,不断随机生成数据寻找适应规则数据,逐步迭代求取最优。 测试环境:Excel 测试语言:VBA 1. 仿真数据生成(采用圆和直线) 2. 实验结果数据 3.粗糙算法代码 Const circle_point_...

空空如也

空空如也

1 2
收藏数 38
精华内容 15
热门标签
关键字:

vba中的const