精华内容
下载资源
问答
  • vb中const与dim区别?

    千次阅读 2018-11-19 13:10:47
    1.vb中国const源于constant,意思为不变,常量。用const声明的是固定的整数,字符串 2.但是dim不同,dim声明后,redim可以进行重置,声明的是变量

    1.vb中const源于constant,意思为不变常量。用const声明的是固定的整数,字符串
    2.但是dim不同,dim声明后,redim可以进行重置,声明的是变量

    展开全文
  • EXCEL VBA 常量与变量

    2019-03-02 11:29:27
    常量与变量的说明,新手可以拿来参考参考。
  • VBA基础打卡

    2017-11-13 23:19:30
    vba

    1、VBA 共有 12 种数据类型,可以根据数据类型用 Type 自定义数据类型。

    2、VBA 允许使用未定义的变量,默认是变体变量,默认是变体变量Variant。

    Dim  变量 as 类型   '定义为局部变量,如 Dim   xyz as integer (整数型 %)

    Private 变量 as 类型   '定义为私有变量,如 Private  xyz as byte (字节型)

    Public 变量 as 类型   '定义为公有变量,如 Public  xyz as single (单精度型 !)

    Global  变量 as 类型   '定义为全局变量,如 Globlal  xyz as date(日期型)

    Static 变量 as 类型   '定义为静态变量,如 Static  xyz as double(双精度型 #)

    变量名必须以字母开始,并且只能包含字母数字和特定的特殊字符,不能包含空格句号 惊叹号,也不能包含字符@ & $ #.名字最大长度为 255 个字符

    3、常量为变量的一种特例,用 Const 定义,且定义时赋值,程序中不能改变值,作用域也如同变量作用域。如下定义:

    Const Pi=3.1415926 as single

    4、数组必须用 Global 或 Dim 语句来定义。定义规则如下:

    Dim 数组名([lower to ]upper [, [lower to ]upper, ….]) as type ;Lower 缺省值为 0,可以在模块的声明部分使用Option Base语句来改变模块中数组的起始边界。如 Option Base 1

    该语句使数组元素的索引号从1开始。

    VBA 还有一种功能强大的动态数组,定义时无大小维数声明,在程序中再利用Redim 语句来重新改变数组大小。

    也可以用ReDim关键字同时声明一个动态数组并指定该数组的元素个数:  ReDim array1(5) As double 

    原来数组内容可以通过加 preserve 关键字来保留。

    如下例: Dim array1() as double  ’'定义一个名为array1的双精度动态一维数组

                   Redim array1(5) ‘重定array1(0 to 5), 下界为0,上届为5,包含6个元素

                   array1(3)=250 ’给数组中下届为3的元素赋值为250

                   Redim preserve array1(5,10) ‘重定array1数组为二维数组,第一维((0 to 5) 第二维(0 to 10)

    VBA在重新定义数组大小时,原有的数组数据就会丢失。如果需要保留原来的数据,可以使用Preserve关键字:ReDim Preserve array1(5)

    如果重新定义数组时减小了数组的大小,则会丢失被缩减了的那部分元素的数据。

    5、VBA 中有两种方法标识为注释语句。  

          单引号 ’ ;如:’定义全局变量;可以位于别的语句之尾,也可单独一行  

          Rem ;如:Rem 定义全局变量;只能单独一行

    6、对对象的赋值采用:set myobject=object 或  myobject:=object

    7、书写规范

            VBA 不区分标识符的字母大小写,一律认为是小写字母;

            一行可以书写多条语句,各语句之间以冒号 : 分开;

            一条语句可以多行书写,以空格加下划线 _ 来标识下行为续行

    8、判断语句

         If…Then…Else 语句

         If Number < 10   Then    

              Digits = 1

         ElseIf Number < 100 Then    

              Digits = 2

        Else   

             Digits = 3

         End If

        Select Case…Case…End Case 语句

        Select Case Pid

              Case “A101”

              Price=200

              Case “A102”

              Price=300

              Case Else

              Price=900

              End Case

         Choose 函数

         choose(index, choce-1,choice-2,…,choice-n),可以用来选择自变量串列中的一个值,并将其返回,index 必要参数,数值表达式或字段,它的运算结果是一个数值,且界于

    1 和可选择的项目数之间。 choice 必要参数,Variant 表达式,包含可选择项目的其中之一。

         GetChoice = Choose(Ind, "Speedy", "United", "Federal")

         Switch 函数

          Switch(expr-1, value-1[, expr-2, value-2 _ [, expr-n,value-n]]), switch 函数和 Choose 函数类似,但它是以两个一组的方式返回所要的值,在串列中,最先为TRUE 的值会被返回。 expr 必要参数,要加以计算的 Variant 表达式。value 必要参数。如果相关的表达式为 True,则返回此部分的数值或表达式,没有一个表达式为 True,

    Switch 会返回一个 Null 值。

    9、循环语句

       For Next 语句 

        For Words = 10 To 1 Step -1      ' 建立 10 次循环    

               For Chars = 0 To 9        ' 建立 10 次循环        

                    MyString = MyString & Chars     ' 将数字添加到字符串中   

                Next Chars          

               MyString = MyString & " "     

          Next Words

         For Each…Next 语句  

           For Each rang2 In range1

                With range2.interior

                                  .colorindex=6

                                   .pattern=xlSolid

                    End with

               Next

              With…End With 语句,目的是省去对象多次调用,加快速度。
     
            Do…loop 语句,在条件为 true 时,重复执行区块命令

            Do {while |until} condition    ' while 为当型循环,until 为直到型循环

               Statements

             Exit do

               Statements

            Loop

           或

             Do  ' 先 do 再判断,即不论如何先干一次再说

                 Statements

                Exit do

                 Statements

                 Loop {while |until} condition

    展开全文
  • VBA中调用Windows API的方法

    千次阅读 2019-10-08 17:52:14
    VBA中使用Windows API VBA是一种强大的编程语言,可用于自定义Microsoft Office解决方案。通过使用VBA处理一个或多个Office应用程序对象模型,可以容易地修改Office应用程序的功能或者能够使两个或多个Office应用...

    【转自“文韬武略,天下第一!”】:在VBA中使用Windows API

    VBA是一种强大的编程语言,可用于自定义Microsoft Office解决方案。通过使用VBA处理一个或多个Office应用程序对象模型,可以容易地修改Office应用程序的功能或者能够使两个或多个Office应用程序协同工作以完成单个应用程序无法完成的任务。然而,使用VBA仅能控制操作系统的一小部分。Windows API提供了控制操作系统绝大多数方面的功能。下面,介绍在VBA中使用Windows API的一些知识。

    理解APIs

    API只是一组函数,可用于处理组件、应用程序或操作系统。通常,API由一个或多个提供某种特定功能的DLLs组成。

    DLLs是包含函数的文件,能够从任何运行的Windows应用程序中调用DLLs。在运行时,DLL中的函数被动态链接到调用它的应用程序里。无论多少应用程序调用DLL中的函数,该函数仅存在于磁盘的单个文件中,并且DLL在内存中仅被创建一次。

    您可能最经常听说的API是Windows API,它包括组成Windows操作系统的DLLs。每个Windows应用程序都直接或间接地与Windows API相交互,Windows API确保运行在Windows下的所有应用程序都按一致的方式工作。

    除了Windows API外,还有其它发布的APIs可用。例如,邮件应用程序编程接口(MAPI)是一组用于编写电子邮件应用程序的DLLs。

    APIs通常是由创建Windows应用程序的C和C++程序员编写,但能够使用VBA调用DLL中的函数。因为大多数DLLs最初都是由C/C++程序员编写和文档规范,所以调用DLL函数与调用VBA函数不同。为了使用API,必需理解如何传递参数到DLL函数。

    为了调用Windows API中的函数,需要描述这些可用的函数的文档规范,如何在VBA中声明这些函数,以及如何调用它们。下面是两个有用的资源:

    1、Win32API.txt文件,包含Windows API中大多数函数的VBA Declare(声明)语句。可以使用API Viewer加载宏查找和复制需要的Declare语句。可以在下面的站点下载API声明查看器:

    http://www.activevb.de/rubriken/apiviewer/index-apiviewereng.html

    win32api.txt文件下载:

    2、Microsoft Platform SDK,包含复杂的Windows API文档。可以在下面的地址中查看:
    https://docs.microsoft.com/en-us/windows/win32/api/_winmsg/

    使用Declare语句

    在从VBA中调用DLL里的函数之前,必须为VBA提供在哪里找到函数以及如何调用该函数的信息,有两种方法:

    1、设置对DLL类型库的引用。

    2、在模块中使用Declare语句。

    设置对DLL类型库的引用是使用DLL中的函数的最容易的方法。一旦设置引用,就可以将其当作工程里的一部分一样调用DLL函数。然而,也要注意一些事项。首先,设置对多个类型库的引用会影响应用程序的性能;其次,不是所有的DLLs都提供类型库,虽然可以对没有提供类型库的DLL设置引用,但不能调用该DLL中的函数。

    注意,组成Windows API的DLLs没有提供类型库,因此不能设置对它们的引用并调用其中的函数。要调用Windows API中的函数,必须在工程里模块的声明部分包括Declare语句。

    Declare语句是一个定义,告诉VBA在哪里找到特定的DLL函数以及如何调用该函数。在代码中添加Declare语句最简单的办法是使用API Viewer加载宏,其中包含Windows API中大多数函数的Declare语句,也包含一些函数所需要的常量和类型定义。

    Declare语句声明的形式如下:

    [Public|Private]Declare Sub name Lib "libname" [Alias "aliasname"][([arglist])]
    [Public|Private]Declare Function name Lib "libname" [Alias "aliasname"] [([arglist])] [As type]
    

    下面是GetTempPath函数的Declare语句的示例,该函数返回Windows临时文件夹的路径(默认为C:\Windows\Temp):

    Private Declare Function GetTempPath Lib "kernel32" _
    Alias "GetTempPathA" (ByVal nBufferLength As Long, _
    ByVal lpBuffer As String) As Long
    

    关键字Declare告诉VBA在工程中要包含的DLL函数的定义。在标准模块中的Declare语句可以是公共的或私有的,取决于你希望API函数仅用于单个模块还是整个工程。在类模块中,Declare语句必须是私有的。

    在关键字Function之后是函数的名字,具体地说,是从VBA中调用该函数时使用的名字。这个名字可以与API函数本身的名字相同,也可以在Declare语句中使用关键字Alias指定打算在VBA中通过不同的名字(别名)调用该函数。

    在上面的示例中,在DLL中API函数的名字是GetTempPathA,从VBA中调用该函数时使用的名字是GetTempPath。注意,DLL函数的实际名字出现在关键字Alias之后,同时也注意到GetTempPath是Win32API.txt文件用于该函数的别名,但你可以将其改变为任何你想要的名字。

    下面是为什么要在Declare语句中使用别名的一些理由:

    • 一些API函数的名字以下划线(_)开始,在VBA中是不合乎语法的。为了从VBA中调用该函数,需要使用别名。
    • 因为别名允许将DLL函数命名为你所希望的名字,所以可以使函数名字遵循你自已在VBA中的命名标准。
    • 因为API函数是区分大小写的,而VBA函数则不,所以可以使用别名来改变函数名的大小写。
    • 一些DLL函数带有接受不同数据类型的参数,这些函数的VBA声明语句定义这些参数为类型Any,调用带有声明为Any的参数的DLL函数是危险的,因为VBA不会执行任何数据类型检查。如果想避免传递类型为Any的参数的危险,可以声明相同的DLL函数的多个版本,每一个都具有不同的名字和不同的数据类型。
    • Windows API为所有接受字符串参数的函数都包含两个版本:ANSI版和Unicode版。ANSI版带有"A"后缀,正如上例所示,而Unicode版带有"W"后缀。虽然VBA使用Unicode,但在调用DLL中的函数之前,它将所有的字符串转换为ANSI字符串,因此在从VBA中调用Windows API函数时通常使用ANSI版。API Viewer加载宏自动为所有接6受字符串参数的函数命名别名,因此可以不必包含"A"后缀而调用该函数。

    关键字Lib指定包含函数的DLL。注意,在声明语句里以字符串形式包含DLL的名字。如果在系统中没有找到关键字Lib之后指定的DLL,对该函数的调用将失败,导致运行时错误:48,装载DLL错误。因为可以在VBA代码中处理这种错误,所以可以编写健壮的代码得体地处理错误。

    下面列出了Windows API中最常使用的DLLs:

    • Kernel32.dll:低级别的操作系统函数,例如内存管理和资源处理。
    • User32.dll:Windows管理函数,例如消息处理、计时器、菜单和通讯。
    • GDI32.dll:图像设备接口(GDI)库,包含设置输出的函数,例如绘图、显示上下文和字体管理。

    大多数DLLs,包括Windows API中的DLLs,都采用C/C++编写,因此,传递参数到DLL函数需要参数的理解以及C/C++接受的数据类型,而这些不同于VBA函数。

    同时,DLL函数的许多参数按值传递。默认情况下,VBA中的参数按引用传递。因此,当DLL函数需要按值传递的参数时,在函数定义中包括关键字ByVal是必要的。在函数定义中忽略ByVal关键字可能会在应用程序中导致无效的页错误。有时,可能会发生VBA运行时错误:49,坏的DLL调用协议。

    按引用传递参数传递该参数的内存位置到被调用的过程,如果该过程修改了参数的值,那么会修改该参数的唯一的副本,因此,当返回到调用过程时,参数包含的是修改后的值。

    按值传递参数到DLL函数,将传递该参数的副本,函数操作该参数的副本,避免了修改实际参数的内容。当返回到调用过程时,该参数包含与调用其它过程前相同的值。

    因为按引用传递允许在内存中修改参数值,如果不恰当地按引用传递参数,DLL函数可能会覆盖它不应该覆盖的内存,导致错误或者不可预料的结果。Windows维护许多值不应该被覆盖,例如,Windows为每个窗口赋惟一的32位标识符,称作句柄(handle)。句柄总是按值传递给API函数,因为如果Windows修改了某窗口的句柄,那么不再能够追踪到该窗口。(虽然关键字ByVal出现在String类型的一些参数前面,但是字符串总是按引用被传递到Windows API函数)

    上述声明语句接受两个参数,一个为Long型,另一个为String型,并返回一个Long型值。

    使用常量

    除了DLL函数的声明语句外,一些函数还需要定义常量以及在函数中使用的类型。在模块的声明部分包括常量和用户定义类型。

    如何知道函数需要的常量和用户定义类型呢?需要查看该函数的文档。Win32API.txt文件包含函数的常量和用户定义类型的定义。可以使用API Viewer加载宏找出这些常量和用户定义类型,并将它们复制到代码中。不巧的是,常量和用户定义类型不会以任何方式与需要它们的声明语句相联系,因此,仍然需要检查DLL函数的文档,决定哪个常量和类型与哪个声明语句匹配。

    函数可能需要传递常量来指明想要函数返回的信息。例如,GetSystemMetrics函数接受75个常量,每一个都指定操作系统的不同方面,该函数返回的信息取决于传递给它的常量。要调用GetSystemMetrics,不需要包括所有的75个常量,只需包括要使用的就可以了。

    建议定义常量而不是简单地传递它们代表的值。Microsoft确保在将来的版本中仍然会保留相同的常量,但不保证常量的值相同。

    DLL函数需要的常量通常是隐含的,因此需要查阅函数的文档来确定传递的常量,以返回特定的值。

    在《Professional Excel Development》中介绍了如何查找常量的值的方法。即在Microsoft的站点下载并安装核心SDK软件包,其中有一个名为"include"的子目录,所有用于创建动态链接库(DLL)的C++头文件都存放在这个目录中。通过搜索就能找到常量所在的文件,例如查找SM_CXSCREEN,会返回文件"winuser.h",打开该文件查询就可找到相关的常量。

    下面的示例是包括GetSystemMetrics函数的声明语句,接受两个常量,然后展示如何从属性过程中调用GetSystemMetrics,以像素为单位返回屏幕的高度。

    Declare Function GetSystemMetrics Lib "User32" (ByVal nIndex As Long) As Long
    Const SM_CXSCREEN As Long = 0 '屏幕宽度
    Const SM_CYSCREEN As Long = 1 '屏幕高度
    
    Public Property Get ScreenHeight() As Long
    '以像素为单位返回屏幕的高度
    ScreenHeight = GetSystemMetrics(SM_CYSCREEN)
    End Property
    
    Public Property Get ScreenWidth() As Long
    '以像素为单位返回屏幕的宽度
    ScreenWidth = GetSystemMetrics(SM_CXSCREEN)
    End Property
    

    使用用户定义类型

    用户定义类型是一种数据结构,可以存储多个相关的不同类型的变量,与C/C++中的结构一致。有时,传递空的用户定义类型到DLL函数,函数填充值;有时,从VBA填充用户定义类型,并将其传递给DLL函数。

    可以将用户定义类型作为一箱抽屉,每个抽屉可以包含不同类型的项目,但将它们组合在一起可以当作相关项目的单个箱子。可以从任何抽屉获得项目而不必担心存储在任何其它抽屉中的项目。

    要创建用户定义类型,使用Type … End Type语句。在Type…End Type语句里,列出了每个项目,包含值和数据类型。用户定义类型的元素可以是数组。

    下面的代码段展示如何定义RECT用户定义类型,和管理屏幕矩形块的几个Windows API函数一起使用。例如,GetWindowRect函数接受RECT类型的数据结构,使用关于窗口的左侧、顶部、右侧和底部位置的信息填充。

    Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
    End Type
    

    要传递用户定义类型到DLL函数,必须创建该类型的变量。例如,如果打算传递RECT类型的用户定义类型到DLL函数,那么就要包括变量声明,如下所示:

    Private rectWindow As RECT
    

    可以引用用户定义类型里的单个元素,如下所示:

    Debug.Print rectWindow.Left
    

    使用句柄

    调用DLLs中的函数之前需要理解的另一个重要的概念是句柄(handle)。简单地说,句柄是32位正整数,Windows用于识别窗口或另一个对象,例如字体或位图。

    在Windows中,窗口有许多不同的表现形式。事实上,在屏幕中看到的几乎所有事情都在窗口里,并且不能看到的大多数事情也在窗口里。窗口能够是一个绑定的屏幕矩形区域,就像您习惯看到的应用程序窗口一样。窗体中的控件,例如列表框或滚动条,也都是窗口,虽然不是所有类型的控件都是窗口。在桌面上显示的图标以及桌面本身,都是窗口。

    因为所有这些类型的对象都是窗口,所以Windows能够相同地对待它们。Windows提供给每个窗口一个唯一的句柄,并使用该句柄去处理窗口。许多API函数返回句柄或者接受句柄作为其参数。

    当窗口创建时Windows赋句柄给该窗口,当窗口销毁时Windows释放该句柄。虽然句柄保留的时间与窗口存在的时间相同,但不保证一个窗口在销毁并重新创建后有相同的句柄。因此,如果在变量中存储句柄,那么记住该窗口销毁后,该句柄不再有效。

    GetActiveWindow函数是返回窗口句柄的函数示例,此时,应用程序窗口是当前活动的窗口。GetWindowText函数接受某窗口的句柄,并且如果窗口有标题的话返回该窗口的标题。下面的程序使用GetActiveWindow返回活动窗口的句柄,GetWindowText返回其标题:

    Declare Function GetActiveWindow Lib "user32" () As Long
    Declare Function GetWindowText Lib "user32" _
    Alias "GetWindowTextA" (ByVal Hwnd As Long, _
    ByVal lpString As String, ByVal cch As Long) As Long
     
    Function ActiveWindowCaption() As String
    Dim strCaption As String
    Dim lngLen As Long
    '创建使用空字符填充的字符串
    strCaption = String$(255, vbNullChar)
    '返回字符串的长度
    lngLen = Len(strCaption)
    '调用GetActiveWindow来返回活动窗口的句柄
    '与字符串和其长度一起,传递句柄到GetWindowText
    If (GetWindowText(GetActiveWindow, strCaption, lngLen) > 0) Then
    '返回Windows已写入的值给字符串
    ActiveWindowCaption = strCaption
    End If
    End Function
    

    GetWindowText函数接受三个参数:窗口的句柄、将返回窗口标题里的空结尾的字符串、以及字符串的长度。

    下面列出了Excel中常用的窗口类名称:

    • Excel主窗口:XLMAIN
    • Excel桌面:XLDESK
    • Excel工作表:EXCEL7
    • Excel用户窗体:ThunderDFrame(Excel 2000以后版本)、ThunderRT6DFrame(Excel 2000以后版本,用于作为COM加载项时)、ThunderXFrame(Excel 97)
    • Excel状态栏:EXCEL4
    • Excel图表窗口:EXCELE(Excel2007以前版本)

    FindWindow函数使用类名和窗口标题查找窗口。下面的代码以像素为单位查找Excel主窗口的位置和大小:

    '包含窗口大小的用户定义类型
    Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
    End Type
    
    '查找窗口的API函数
    Declare Function FindWindow Lib "user32" _
    Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
     
    '获取窗口大小的API函数
    Declare Function GetWindowRect Lib "user32" ( _
    ByVal hWnd As Long, _
    lpRect As RECT) As Long
     
    Sub ShowExcelWindowSize()
    Dim hWnd As Long, uRect As RECT
    '获取Excel主窗口的句柄
    'Excel 2002及以后版本也可使用hWnd=Application.Hwnd
    hWnd = FindWindow("XLMAIN", Application.Caption)
    '将窗口大小信息存入到RECT结构中
    GetWindowRect hWnd, uRect
    '显示结果
    MsgBox "这个Excel窗口的尺寸为:" & _
    vbCrLf & "左侧:" & uRect.Left & _
    vbCrLf & "右侧:" & uRect.Right & _
    vbCrLf & "顶部:" & uRect.Top & _
    vbCrLf & "底部:" & uRect.Bottom & _
    vbCrLf & "宽度:" & (uRect.Right - uRect.Left) & _
    vbCrLf & "高度:" & (uRect.Bottom - uRect.Top)
    End Sub
    

    调用函数

    虽然调用DLL函数的许多方式与调用VBA函数相似,但是开始时有一些不同可能会使DLL函数混淆。下面将介绍如何输入DLL函数中的参数并加前缀、如何返回字符串、如何传递数据结构、能够接受什么返回值、以及如何获取错误信息。

    参数数据类型

    在C/C++中使用的数据类型、用于描述它们的标记都不同于在VBA中的用法,下面描述了DLL函数中常用的数据类型以及它们在VBA中的等效表示。

    C/C++数据类型匈牙利前缀描述等效的VBA表示
    BOOLb8位布尔值。0表示False;非0表示TrueBoolean或Long
    BYTEch8位无符号整数Byte
    HANDLEh32位无符号整数,代表Windows对象的句柄Long
    intn16位符号整数Integer
    longl32位符号整数Long
    LPlp32位对内存中C/C++结构、字符串、函数或其它数据的长指针Long
    LPZSTRlpsz32位对C类型空结尾字符串的长指针Long

    虽然您应该熟悉这些数据类型和前缀,但前面提到的Win32API.txt文件包含了准备在VBA中使用的声明语句。如果在代码中使用这些声明语句,那么函数参数已经定义了正确的VBA数据类型。

    在《Excel 2007 VBA参考大全》的第27章,详细介绍了如何将C-样式声明转换为VBA声明语句。

    只要已经定义并传递了正确的数据类型,调用DLL函数与调用VBA函数采取相同的方法。当然也有例外,这将在下面的内容中介绍。

    从DLL函数中返回字符串

    DLL函数不会以VBA函数相同的方法返回字符串。因为字符串总是按引用传递到DLL函数,DLL函数能够修改字符串参数的值。宁可返回字符串作为函数的返回值,就像可能在VBA中做的那样,DLL函数返回字符串到传递给该函数的String类型的参数。函数的实际返回值经常是一个长整型值,指定写入到字符串参数的字节数量。

    接受字符串参数的DLL函数获得指针,指向内存中该字符串的位置。指针只是内存地址,表明在哪里存储字符串。因此,当从VBA中传递字符串到DLL函数时,传递给DLL函数一个指针,指向内存中的字符串。接着,这个DLL函数修改存储在那个地址的字符串。

    要调用写到String变量的DLL函数,需要采取额外的步骤合适地格式字符串。首先,String变量必须是空结尾字符串。一个空结尾字符串以特定的空字符结束,空字符通过VBA常量vbNullChar来指定。

    其次,DLL函数不能修改已经创建的字符串的大小。因此,需要确保传递给函数的字符串足够大以容纳整个返回值。当传递字符串到DLL函数中时,通常需要指定在另一个传递的参数中字符串的大小。Windows追踪字符串的长度,以确保不会覆盖掉字符串已使用过的内存。

    传递字符串到DLL函数中的一个好方法是创建String变量,并使用String$函数在其中填充空字符,使其足够大以容纳函数返回的字符串。例如,下面的代码创建一个144字节长的字符串,并使用空字符串填充:

    Dim strTempPath As String
    strTempPath = String$(144, vbNullChar)
    

    当传递字符串到DLL函数中时,如果不知道字符串的长度,那么可以使用Len函数确定其长度。

    获取Windows临时文件夹的GetTempPath函数,就是返回String值的DLL函数的例子。该函数接受两个参数,一个空结尾的字符串变量和一个包含字符串长度的数值变量。修改该字符串以便包含路径,例如C:\Temp\。(Windows需要一个临时文件夹存在,于是该函数应该总是返回该文件夹的路径。如果由于某种原因不存在临时文件夹,GetTempPath返回0)。

    下面的程序调用GetTempPath函数获取Windows临时文件夹的路径:

    Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
    (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
    
    Property Get GetTempFolder() As String
    '返回用户临时文件夹的路径.
    '对于根目录,Windows需要一个临时文件夹存在
    '因此应该总是返回其路径
    '以防万一,检查GetTempPath的返回值
    Dim strTempPath As String
    Dim lngTempPath As Long
    '使用空字符填充字符串
    strTempPath = String(144, vbNullChar)
    '获得字符串的长度
    lngTempPath = Len(strTempPath)
    '调用GetTempPath,传递字符串长度和字符串
    If (GetTempPath(lngTempPath, strTempPath) > 0) Then
    'GetTempPath返回路径到字符串中.
    '截去字符串开始的空字符
    GetTempFolder = Left(strTempPath, InStr(1, strTempPath, vbNullChar) - 1)
    Else
    GetTempFolder = ""
    End If
    End Property
    

    注意,当传递字符串到函数中时,使用空字符填充该字符串。函数写入返回的字符串值"C:\Temp"到字符串变量的第一部分中,并且剩下的保留空字符填充,接着使用Left函数截取字符串。

    GetTempPath函数的实际返回值是已经被写到字符串变量中的字符数。如果返回的字符串是"C:\Temp",那么GetTempPath函数返回8。

    注意,这仅对从函数返回字符串时传递空结尾字符串及其大小是必需的。如果函数不返回字符串到字符串参数中,而是接受对函数指定信息的字符串,那么只需传递正常的VBA字符串变量。

    传递用户定义类型到DLL函数

    许多DLL函数需要通过使用预定义的格式传递数据结构。当从VBA中调用DLL函数时,根据函数的需求传递已经定义的用户定义类型。

    通过查看函数的声明语句,您能够理解什么时候需要传递用户定义类型以及需要在代码中包括哪种类型定义。需要数据结构的参数总是被声明为长指针:指向内存中数据结构的32位数字值。为长指针参数约定的前缀是"lp"。此外,参数的数据类型是数据结构的名称。

    例如,看看GetLocalTime函数和SetLocalTime函数的声明语句:

    Private Declare Sub GetLocalTime Lib "kernel32" _
    (lpSystem As SYSTEMTIME)
    Private Declare Function SetLocalTime Lib "kernel32" _
    (lpSystem As SYSTEMTIME) As Long
    

    两个函数都接受SYSTEMTIME类型的参数,即包含日期和时间信息的数据结构。下面是SYSTEMTIME类型的定义:

    Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
    End Type
    

    要将数据结构传递给函数,必须声明SYSTEMTIME类型的变量,如下所示:

    Private sysLocalTime As SYSTEMTIME
    

    当调用GetLocalTime时,传递SYSTEMTIME类型的变量到该函数,并且使用表示当前本地的年、月、日、星期几、小时、分、秒、毫秒的数字值填充该数据结构。例如,下面的Property Get程序调用GetLocalTime返回表明当前小时的值:

    Public Property Get Hour() As Integer
    '返回当前时间,然后返回小时
    GetLocalTime sysLocalTime
    Hour = sysLocalTime.wHour
    End Property
    

    当调用SetLocalTime时,也传递了SYSTEMTIME类型的变量,但首先提供数据结构的一个或多个元素的值。例如,下面的Property Let程序设置本地系统时间的小时值。首先,调用GetLocalTime函数获取本地时间的当前值到数据结构中,然后使用传递给属性过程的值更新数据结构的sysLocalTime.wHour的值。最后,调用SetLocalTime函数,传递相同的数据结构,包含通过GetLocalTime加新小时值而取得的值。

    Public Property Let Hour(intHour As Integer)
    '获取当前时间以便所有值都是当前的
    '然后设计本地时间的小时部分
    GetLocalTime sysLocalTime
    sysLocalTime.wHour = intHour
    SetLocalTime sysLocalTime
    End Property
    

    GetLocalTime函数和SetLocalTime函数与GetSystemTime函数和SetSystemTime函数相似。主要的不同在于,GetSystemTime函数和SetSystemTime函数表达的时间为格林威治标准时间。例如,如果本地时间是午夜12时,而您居住在西海岸,那么格林威治标准时间就是上午8时,有8小时的时差。GetSystemTime函数返回当前时间即8:00 A.M,而GetLocalTime返回午夜12:00。

    理解Any数据类型

    一些带有一个参数的DLL函数可以接受多个数据类型。在DLL函数的声明语句中,这样的参数被声明为类型Any。VBA允许传递任何数据类型到这个参数。然而,DLL函数可能被设计为接受仅仅两个或三个不同的数据类型,因此传递错误的数据类型可能会导致应用程序错误。

    通常,当在VBA工程中编译代码时,VBA对传递给每个参数的值执行类型检查。也就是说,确保传递的值的数据类型与函数定义中的参数的数据类型相匹配。例如,如果参数定义为Long型,而试图传递String型的数值,则会发生编译时错误。这适用于调用内置的VBA函数、用户定义函数、或者DLL函数。当将参数声明为类型Any时,不会进行类型检查,因此当传递值到这种类型的参数时应该谨慎。

    一些具有一个参数的DLL函数可以接受字符串或者指向字符串的空指针。指向字符串的空指针是一个特别的指针,指令Windows忽略所给的参数。它与零长度字符串("")不同。在VBA的早期版本中,程序员必须声明参数为类型Any,或者声明DLL函数的两个版本,即一个版本定义参数类型为String,一个版本定义参数类型为Long。现在VBA包括vbNullString常量,代表指向字符串的空指针,这样可以声明参数为String类型,并且在需要传递空指针的情形下传递vbNullString常量。

    获取错误信息

    DLL函数中发生的运行时错误的行为不同于VBA中的运行时错误,即没有错误消息框显示。当运行时错误发生时,DLL函数返回某值表时发生了错误,而且错误不会中断VBA代码的执行。

    Windows API中的一些函数存储运行时错误的错误信息。如果使用C/C++编程,可以使用GetLastError函数获取关于发生的最后一次错误的信息。然而,从VBA中,GetLastError函数可能返回不确切的结果。要从VBA获得关于DLL错误的信息,可以使用VBA的Err对象的LastDLLError属性。LastDLLError属性返回发生的错误号。

    为了使用LastDLLError属性,需要知道与错误相对应的错误号。在Win32API.txt文件没有这方面的可用信息,而Microsoft Platform SDK中可以找到。

    下面的示例展示在已经调用了Windows API中的函数后如何使用LastDLLError属性。PrintWindowCoordinates程序接受窗口句柄,并调用GetWindowRect函数。GetWindowRect使用组成窗口的矩形的边的长度填充RECT数据结构。如果传递了无效的句柄,将发生错误,并且可以通过LastDLLError属性获得错误号。

    Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
    lpRect As RECT) As Long
     
    Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
    End Type
     
    Const ERROR_INVALID_WINDOW_HANDLE As Long = 1400
    Const ERROR_INVALID_WINDOW_HANDLE_DESCR As String = "无效的窗口句柄."
     
    Sub PrintWindowCoordinates(hwnd As Long)
    '以像素为单位打印窗口左侧,右侧,顶部和底部位置
    Dim rectWindow As RECT
    '传递窗口句柄和空的数据结构
    '如果函数返回0,那么错误就发生了
    If GetWindowRect(hwnd, rectWindow) = 0 Then
    '因为传递了无效的句柄
    '所以如果发生错误则检查LastDLLError并显示对话框
    If Err.LastDllError = ERROR_INVALID_WINDOW_HANDLE Then
    MsgBox ERROR_INVALID_WINDOW_HANDLE_DESCR, _
    Title:="错误!"
    End If
    Else
    Debug.Print rectWindow.Bottom
    Debug.Print rectWindow.Left
    Debug.Print rectWindow.Right
    Debug.Print rectWindow.Top
    End If
    End Sub
    

    要获得活动窗口的坐标,可以通过使用GetActiveWindow函数返回活动窗口的句柄,并将结果传递到前面示例定义的过程中。要使用GetActiveWindow函数,包括下面的声明语句:

    Declare Function GetActiveWindow Lib "user32" () As Long
    

    输入下面的过程后运行:

    Sub test()
    PrintWindowCoordinates (GetActiveWindow)
    End Sub
    

    要生成一条错误消息,随便使用一个长整型数值调用这个过程。

    参考资源:

    David Shank,《Office VBA and the Windows API》

    《Excel 2007 VBA参考大全》

    《Professional Excel Development》

    《VBA and Macros for Microsoft Excel》

    展开全文
  • VBA调用C++DLL

    2021-01-06 05:44:00
    VBA调用C++DLL C++DLL示例 以下建立了一个比较简单的C++的DLL,它的输入是一个字符串,两个double类型的变量,输出double类型的计算结果。 CPP代码: #include stdafx.h #include test_excel.h double fun_property...
  • vba 时间换算 服务及其功能 (Services and their features) Exchange rates can be obtained from many sources, some free, some paid. 汇率可以从许多来源获得,有的是免费的,有的是付费的。 Hardly two of ...

    vba 时间换算

    服务及其功能 (Services and their features)

    Exchange rates can be obtained from many sources, some free, some paid.

    汇率可以从许多来源获得,有的是免费的,有的是付费的。

    Hardly two of these serve the same purpose or are targeted the same users. This means, that some research typically is necessary to pick the service that will fit a given scenario and demand. Several factors come into play:

    其中几乎没有两个服务于相同的目的或针对相同的用户。 这意味着,通常需要进行一些研究才能选择适合给定场景和需求的服务。 有几个因素起作用:

    • authority - rates provided by national banks have high trust

      授权-国家银行提供的利率具有高度信任
    • interface - what code is needed to retrieve the data

      界面-检索数据需要什么代码
    • range of currencies - from and to which currencies is the demand for

      货币的范围- 哪个货币为所述需求
    • update frequency - once a day or more often

      更新频率-每天一次或更频繁
    • costs - can a fee be accepted, or must the service be free to use

      费用-可以接受费用,还是必须免费使用服务

    Only one factor - code examples for the interfaces - we take care of here; the rest is up to you, and you will have to visit the various websites to obtain the current details and further info before making a decision.

    只有一个因素-接口的代码示例-我们在这里处理; 其余的一切取决于您,您将需要访问各个网站以获取当前的详细信息和更多信息,然后再做出决定。

    提供的服务 (Services offered)

    The services, that this project addresses, are:

    该项目要解决的服务是:

    1. The European Central Bank

    1.欧洲中央银行

    2. The Danish National Bank

    2.丹麦国家银行

    3. The Central Bank of the Russian Federation

    3.俄罗斯联邦中央银行

    4. Currency Converter API

    4.货币转换器API

    5. Currencylayer API

    5. Currencylayer API

    6. ExchangeRate API

    6. ExchangeRate API

    7. Fixer

    7.固定器

    8. Open Exchange Rates

    8.开放汇率

    9. php.mk - National Bank of the Republic of North Macedonia

    9. php.mk-北马其顿共和国国家银行

    10. XE

    10. XE

    All services support the currencies commonly used in international trade; for more exotic currencies, you may be limited in the choice of service.

    所有服务都支持国际贸易中常用的货币; 对于更多外来货币,您可能无法选择服务。

    For free, a few services provide exchange rates from any base currency, some provide exchange rates based on one currency only, some only one or a few currencies based on any currency, and one provides exchange rates to one currency only (Euro, The European Central Bank). One service, XE, offers no free plan or subscription at all, only a seven-day trial.

    免费提供一些服务,可以提供任何基础货币的汇率,一些服务仅提供基于一种货币的汇率,一些服务仅提供一种或几种基于任何货币的汇率,而一种服务仅提供一种货币的汇率(欧元,欧洲中央银行)。 XE一项服务根本不提供免费计划或订阅,仅提供7天的试用期。

    The exchange rates published by the services are what is called mid-market rates. This means, that they cannot be used for real transactions; for such, you must refer to the actual buying and selling rates of your bank or broker.

    这些服务发布的汇率称为中端市场汇率 。 这意味着它们不能用于真实交易; 为此,您必须参考银行或经纪人的实际买卖价格。

    功能 (Functions)

    Like the services differ in offerings, so do the various APIs or download options, though only three basic techniques are used:

    就像服务在提供的产品中有所不同一样,各种API或下载选项也是如此,尽管仅使用了三种基本技术:

    1. addressing an API, delivering data as Json

      解决API,以Json的形式传递数据
    2. reading an XML document

      读取XML文档
    3. parsing an HTML document (web scraping, data extracting)

      解析HTML文档(网络抓取,数据提取)

    However, no two services - even using the same basic technique - offer the same data format; thus a custom function is required for each service.

    但是,即使使用相同的基本技术,也没有两个服务提供相同的数据格式。 因此,每个服务都需要自定义功能。

    The main functions offered are named:

    提供的主要功能为:

    ExchangeRatesXyz

    ExchangeRatesXyz

    where Xyz is a three-letter abbreviation of the service name.

    Xyz是服务名称的三个字母的缩写。

    Each of these functions returns an array with the rates, and also attempts to cache the download for two reasons:

    这些函数中的每一个都会返回一个包含费率的数组,并出于两个原因而尝试缓存下载:

    • to speed up reading the rates multiple times

      加快多次读取汇率
    • to save the usage of and the load on the service

      以节省服务的使用和负载

    The returned array is simple - with three or four dimensions of various data types:

    返回的数组很简单-具有三个或四个维度的各种数据类型:

    1. Publishing date (Date)

      出版日期(日期)
    2. ISO currency code (Three-letter string)

      ISO货币代码(三字母字符串)
    3. Exchange rate (Double)

      汇率(双倍)
    4. (Optional) Currency name (string)

      (可选)货币名称(字符串)

    Thus, a typical call will be:

    因此,典型的调用将是:

    Dim ArrayOfExhangeRates As Variant
    
    ArrayOfExhangeRates = ExchangeRatesXyz() 
    

    The functions are supplemented with a set of matching functions for converting an amount from one currency to another. These are named in a similar way:

    这些功能补充有一组匹配功能,用于将金额从一种货币转换为另一种货币。 这些以类似的方式命名:

    CurrencyConvertXyz

    CurrencyConvertXyz

    These functions each utilise the output from the corresponding ExchangeRatesXyz function. Further, they cache the conversion factor for a set of currencies to speed up the calculation of many amounts between the same two currencies. 

    这些函数各自利用相应的ExchangeRatesXyz函数的输出。 此外,它们缓存一组货币的转换因子,以加快相同两种货币之间许多金额的计算。

    The returned value is the conversion factor between the two passed currency codes, for example:

    返回值是两个传递的货币代码之间的转换因子 ,例如:

    Dim ConversionFactor As Double
    
    ConversionFactor = CurrencyConvertXyz("BBB", AAA") 
    

    All functions support the neutral currency code XXX for an exchange rate of 1.

    所有功能均支持1汇率的中性货币代码 XXX


    (
    )

    早期或晚期绑定(32位或64位) (Early or late binding, 32- or 64-bit)

    Where relevant, all functions support both early and late binding. Code has been tested with both 32-bit and 64-bit Microsoft Access 2016 and Access 365.

    在相关情况下,所有功能均支持早期和晚期绑定。 代码已通过32位和64位Microsoft Access 2016Access 365进行了测试

    The Json modules from the project VBA.CVRAPI are required for those functions that retrieve data as Json.

    那些将数据作为Json检索的功能需要项目VBA.CVRAPI中的Json模块。

    服务内容 (The services)

    1.欧洲中央银行 (1. The European Central Bank)

    2.丹麦国家银行 (2. The Danish National Bank)

    The ECB and The Danish National Bank offer a daily list of exchange rates for selected currencies, indeed all the European other than Euro. These can be downloaded as an XML file, but our functions read them directly and transform them to an array in a few steps. 

    欧洲央行和丹麦国家银行提供特定货币的每日汇率清单,实际上是除欧元以外的所有欧洲货币。 这些可以作为XML文件下载,但是我们的函数可以直接读取它们,并通过几个步骤将它们转换为数组。

    Note the use of static variables to prevent unnecessary repeated calls to the site. Effectively, the data will only be retrieved once per day. After the first call, the static array Rates, holding the exchange rates of the day, will be returned directly for all subsequent calls, speeding these up vastly.

    请注意使用静态变量,以防止不必要的重复调用该站点。 实际上,每天仅检索一次数据。 第一次通话后,将为以后的所有通话直接返回保存当天汇率的静态数组Rates,从而大大加快了通话速度。

    The in-line comments explain each step, for example for the ECB:

    在线注释解释了每个步骤,例如针对欧洲央行:

    ' Retrieve the current exchange rates from the European Central Bank, ECB,
    ' for Euro having each of the listed currencies as the base currency.
    ' The rates are returned as an array and cached until the next update.
    ' The rates are updated once a day at about UTC 15:00.
    '
    ' Source:
    '   http://www.ecb.europa.eu/stats/policy_and_exchange_rates/euro_reference_exchange_rates/html/index.en.html
    '
    ' Note:
    '   The exchange rates on the European Central Bank's website are indicative rates
    '   that are not intended to be used in any market transaction.
    '   The rates are intended for information purposes only.
    '
    ' Example:
    '   Dim Rates As Variant
    '   Rates = ExchangeRatesEcb()
    '   Rates(7, 0) -> 2018-05-30       ' Publishing date.
    '   Rates(7, 1) -> "PLN"            ' Currency code.
    '   Rates(7, 2) -> 4.3135           ' Exchange rate.
    '
    ' 2018-06-07. Gustav Brock, Cactus Data ApS, CPH.
    '
    Public Function ExchangeRatesEcb() As Variant
    
        ' Operational constants.
        '
        ' Base URL for European Central Bank exchange rates.
        Const ServiceUrl    As String = "http://www.ecb.europa.eu/stats/eurofxref/"
        ' File to look up.
        Const Filename      As String = "eurofxref-daily.xml"
        ' Update hour (UTC).
        Const UpdateHour    As Date = #3:00:00 PM#
        ' Update interval: 24 hours.
        Const UpdatePause   As Integer = 24
        
        ' Function constants.
        '
        ' Async setting.
        Const Async         As Variant = False
        ' XML node and attribute names.
        Const RootNodeName  As String = "gesmes:Envelope"
        Const CubeNodeName  As String = "Cube"
        Const TimeNodeName  As String = "Cube"
        Const TimeItemName  As String = "time"
        Const CodeItemName  As String = "currency"
        Const RateItemName  As String = "rate"
      
    #If EarlyBinding Then
        ' Microsoft XML, v6.0.
        Dim Document        As MSXML2.DOMDocument60
        Dim XmlHttp         As MSXML2.ServerXMLHTTP60
        Dim RootNodeList    As MSXML2.IXMLDOMNodeList
        Dim CubeNodeList    As MSXML2.IXMLDOMNodeList
        Dim RateNodeList    As MSXML2.IXMLDOMNodeList
        Dim RootNode        As MSXML2.IXMLDOMNode
        Dim CubeNode        As MSXML2.IXMLDOMNode
        Dim TimeNode        As MSXML2.IXMLDOMNode
        Dim RateNode        As MSXML2.IXMLDOMNode
        Dim RateAttribute   As MSXML2.IXMLDOMAttribute
    
        Set Document = New MSXML2.DOMDocument60
        Set XmlHttp = New MSXML2.ServerXMLHTTP60
    #Else
        Dim Document        As Object
        Dim XmlHttp         As Object
        Dim RootNodeList    As Object
        Dim CubeNodeList    As Object
        Dim RateNodeList    As Object
        Dim RootNode        As Object
        Dim CubeNode        As Object
        Dim TimeNode        As Object
        Dim RateNode        As Object
        Dim RateAttribute   As Object
    
        Set Document = CreateObject("MSXML2.DOMDocument")
        Set XmlHttp = CreateObject("MSXML2.ServerXMLHTTP")
    #End If
    
        Static Rates()      As Variant
        Static LastCall     As Date
        
        Dim Url             As String
        Dim CurrencyCode    As String
        Dim Rate            As String
        Dim ValueDate       As Date
        Dim ThisCall        As Date
        Dim Item            As Integer
        
        
        If DateDiff("h", LastCall, UtcNow) < UpdatePause Then
            ' Return cached rates.
        Else
            ' Retrieve updated rates.
        
            ' Define default result array.
            ' Redim for three dimensions: date, code, rate.
            ReDim Rates(0, 0 To 2)
            Rates(0, RateDetail.Date) = NoValueDate
            Rates(0, RateDetail.Code) = NeutralCode
            Rates(0, RateDetail.Rate) = NeutralRate
            
            Url = ServiceUrl & Filename
            
            ' Retrieve data.
            XmlHttp.Open "GET", Url, Async
            XmlHttp.Send
            
            If XmlHttp.Status = HttpStatus.OK Then
                ' File retrieved successfully.
                Document.loadXML XmlHttp.ResponseText
            
                Set RootNodeList = Document.getElementsByTagName(RootNodeName)
                ' Find root node.
                For Each RootNode In RootNodeList
                    If RootNode.nodeName = RootNodeName Then
                        Exit For
                    Else
                        Set RootNode = Nothing
                    End If
                Next
                
                If Not RootNode Is Nothing Then
                    If RootNode.hasChildNodes Then
                        ' Find first level Cube node.
                        Set CubeNodeList = RootNode.childNodes
                        For Each CubeNode In CubeNodeList
                            If CubeNode.nodeName = CubeNodeName Then
                                Exit For
                            Else
                                Set CubeNode = Nothing
                            End If
                        Next
                    End If
                End If
                If Not CubeNode Is Nothing Then
                    If CubeNode.hasChildNodes Then
                        ' Find second level Cube node.
                        Set CubeNodeList = CubeNode.childNodes
                        For Each TimeNode In CubeNodeList
                            If TimeNode.nodeName = TimeNodeName Then
                                Exit For
                            Else
                                Set TimeNode = Nothing
                            End If
                        Next
                    End If
                End If
                
                If Not TimeNode Is Nothing Then
                    If TimeNode.hasChildNodes Then
                        ' Find value date.
                        ValueDate = CDate(TimeNode.Attributes.getNamedItem(TimeItemName).nodeValue)
                        
                        ' Find the exchange rates.
                        Set RateNodeList = TimeNode.childNodes
                        ' Redim for three dimensions: date, code, rate.
                        ReDim Rates(RateNodeList.Length - 1, 0 To 2)
                        For Each RateNode In RateNodeList
                            Rates(Item, RateDetail.Date) = ValueDate
                            If RateNode.Attributes.Length > 0 Then
                                ' Get the ISO currency code.
                                Set RateAttribute = RateNode.Attributes.getNamedItem(CodeItemName)
                                If Not RateAttribute Is Nothing Then
                                    CurrencyCode = RateAttribute.nodeValue
                                End If
                                ' Get the exchange rate for this currency code.
                                Set RateAttribute = RateNode.Attributes.getNamedItem(RateItemName)
                                If Not RateAttribute Is Nothing Then
                                    Rate = RateAttribute.nodeValue
                                End If
                                Rates(Item, RateDetail.Code) = CurrencyCode
                                Rates(Item, RateDetail.Rate) = CDbl(Val(Rate))
                            End If
                            Item = Item + 1
                        Next RateNode
                    End If
                End If
                
                ThisCall = ValueDate + UpdateHour
                ' Record requested language and publishing time of retrieved rates.
                LastCall = ThisCall
                
            End If
        End If
        
        ExchangeRatesEcb = Rates
    
    End Function 
    

    The corresponding conversion functions are also similar. They look up the exchange rates for the two currencies from the retrieved array, and then calculate the relation between these, for example:

    相应的转换函数也相似。 他们从检索到的数组中查找两种货币的汇率,然后计算它们之间的关系,例如:

    ' Returns the current conversion factor from Danish Krone to another currency
    ' based on the official exchange rates published by the Danish National Bank.
    '
    ' Optionally, the conversion factor can be calculated from any other of the
    ' published exchange rates. Exchange rates for other base currencies are
    ' calculated from DKK by triangular calculation.
    '
    ' Source:
    '   http://www.nationalbanken.dk/en/statistics/exchange_rates/Pages/default.aspx
    '
    ' If an invalid or unpublished currency code is passed, a conversion factor
    ' of zero is returned.
    '
    ' Examples, typical:
    '   CurrencyConvertDkk("EUR")           ->  0.134062634062634
    '   CurrencyConvertDkk("EUR", "DKK")    ->  0.134062634062634
    '   CurrencyConvertDkk("AUD")           ->  0.21661901048436
    '   CurrencyConvertDkk("AUD", "DKK")    ->  0.21661901048436
    '   CurrencyConvertDkk("DKK", "AUD")    ->  4.6164
    '   CurrencyConvertDkk("DKK", "EUR")    ->  7.4592
    '   CurrencyConvertDkk("AUD", "EUR")    ->  1.61580452300494
    
    '   CurrencyConvertDkk("", "EUR")       ->  7.4592
    '   CurrencyConvertDkk("DKK")           ->  1
    ' Examples, neutral code.
    '   CurrencyConvertDkk("AUD", "XXX")    ->  1
    '   CurrencyConvertDkk("XXX", "AUD")    ->  1
    '   CurrencyConvertDkk("XXX")           ->  1
    ' Examples, invalid code.
    '   CurrencyConvertDkk("XYZ")           ->  0
    '   CurrencyConvertDkk("EUR", "XYZ")    ->  0
    '
    ' 2018-09-24. Gustav Brock, Cactus Data ApS, CPH.
    '
    Public Function CurrencyConvertDkk( _
        ByVal IsoTo As String, _
        Optional ByVal IsoFrom As String = DanishKroneCode) _
        As Double
        
        Dim Rates()     As Variant
        
        Dim RateTo      As Double
        Dim RateFrom    As Double
        Dim Factor      As Double
        Dim Index       As Integer
        
        If IsoFrom = "" Then
            IsoFrom = DanishKroneCode
        End If
        If IsoTo = "" Then
            IsoTo = DanishKroneCode
        End If
        
        If IsoTo = NeutralCode Or IsoFrom = NeutralCode Then
            Factor = NeutralRate
        ElseIf IsoTo = IsoFrom Then
            Factor = NeutralRate
        Else
            Rates() = ExchangeRatesDkk
        
            If IsoTo = DanishKroneCode Then
                RateTo = NeutralRate
            Else
                For Index = LBound(Rates) To UBound(Rates)
                    If Rates(Index, RateDetail.Code) = IsoTo Then
                        RateTo = Rates(Index, RateDetail.Rate)
                        Exit For
                    End If
                Next
            End If
            
            If RateTo > NoRate Then
                If IsoFrom = DanishKroneCode Then
                    RateFrom = NeutralRate
                Else
                    For Index = LBound(Rates) To UBound(Rates)
                        If Rates(Index, RateDetail.Code) = IsoFrom Then
                            RateFrom = Rates(Index, RateDetail.Rate)
                            Exit For
                        End If
                    Next
                End If
                Factor = RateFrom / RateTo
            End If
            
        End If
        
        CurrencyConvertDkk = Factor
    
    End Function 
    

    Note, that repeated calls will be very fast, as the exchange rates will be retrieved from the cached data in function ExchangeRatesXyz.

    请注意,重复调用将非常快,因为将从功能ExchangeRatesXyz中的缓存数据中检索汇率。

    3.俄罗斯联邦中央银行 (3. The Central Bank of the Russian Federation)

    Exchange rates from this site are available as part of a page - a html table holding the rates. This calls for a different technique than above (for XML data) as the full page has to be retrieved and then parsed to locate the table. If success, the table is then read and converted to our array. 

    来自该网站的汇率可以作为页面的一部分使用-包含汇率的html表 。 由于需要检索整页然后进行解析以查找表,因此这需要一种不同于上述(用于XML数据)的技术。 如果成功,则读取表并将其转换为我们的数组。

    Locating the publishing date takes an additional step. 

    确定发布日期还需要执行其他步骤。

    On top of this, the data must be read as a stream to be able to apply the correct character set, or the Russian names for the currencies would be garbled. ADO is used for this.

    最重要的是,必须将数据读取为流,以便能够应用正确的字符集,否则,货币的俄语名称会出现乱码。 ADO用于此目的。

    "Scraping data" as this is, is a very slow method - and risky too, as you have no guarantee that the page won't change causing the function to fail. However, currently it works well, and - as these data also will be cached - for repeated calls, it will be as fast as the other methods (XML or Json data).

    这样的“抓取数据”是一种非常慢的方法-也是有风险的,因为您不能保证页面不会更改而导致功能失败。 但是,当前它运行良好,并且-由于也会缓存这些数据-对于重复调用,它将与其他方法(XML或Json数据)一样快。

    Again, study the in-line comments to follow the steps taken:

    再次,研究在线注释以遵循以下步骤:

    ' Retrieve the current exchange rates from the Central Bank of the Russian
    ' Federation having RUB as the base currency.
    ' The rates are returned as an array and cached until the next update.
    ' The rates are updated once a day at about UTC 13:00.
    '
    ' Source:
    '   https://cbr.ru/eng/currency_base/daily/
    '
    ' Note:
    '   The Central Bank of the Russian Federation has set the exchange rates of
    '   foreign currencies against the ruble without assuming any liability to
    '   buy or sell foreign currency at the rates.
    '
    ' Example:
    '   Dim Rates As Variant
    '   Rates = ExchangeRatesCbr()
    '   Rates(9, 0) -> 2018-10-06       ' Publishing date.
    '   Rates(9, 1) -> "DKK"            ' Currency code.
    '   Rates(9, 2) -> 10.2697          ' Exchange rate.
    '   Rates(9, 3) -> "Danish Krone"   ' Currency name in English.
    '
    ' 2018-10-07. Gustav Brock, Cactus Data ApS, CPH.
    '
    Public Function ExchangeRatesCbr( _
        Optional ByVal LanguageCode As String) _
        As Variant
    
        ' Operational constants.
        '
        ' API endpoints.
        Const RuServiceUrl  As String = "https://cbr.ru/currency_base/daily/"
        Const EnServiceUrl  As String = "https://cbr.ru/eng/currency_base/daily/"
        
        ' Functional constants.
        '
        ' Page encoding.
        Const Characterset  As String = "UTF-8"
        ' Async setting.
        Const Async         As Variant = False
        ' Class name of data table.
        Const DataClassName As String = "data"
        ' Field items of html table.
        Const CodeField     As Integer = 1
        Const NameField     As Integer = 3
        Const UnitField     As Integer = 2
        Const RateField     As Integer = 4
        ' Locater/header for publishing date: "DT":".
        Const DateHeader    As String = """DT"":"""
        ' Length of formatted date: 2000-01-01.
        Const DateLength    As Integer = 10
        
        ' Update hour (UTC).
        Const UpdateHour    As Date = #1:00:00 PM#
        ' Update interval: 24 hours.
        Const UpdatePause   As Integer = 24
        ' English language code.
        Const EnglishCode   As String = "en"
        ' Russion language code.
        Const RussianCode   As String = "ru"
        
    
    #If EarlyBinding Then
        ' Microsoft XML, v6.0.
        Dim XmlHttp         As MSXML2.ServerXMLHTTP60
        ' Microsoft ActiveX Data Objects 6.1 Library.
        Dim Stream          As ADODB.Stream
        ' Microsoft HTML Object Library.
        Dim Document        As MSHTML.HTMLDocument
        Dim Scripts         As MSHTML.IHTMLElementCollection
        Dim Script          As MSHTML.HTMLHtmlElement
        Dim Tables          As MSHTML.IHTMLElementCollection
        Dim Table           As MSHTML.HTMLHtmlElement
        Dim Rows            As MSHTML.IHTMLElementCollection
        Dim Row             As MSHTML.HTMLHtmlElement
        Dim Fields          As MSHTML.IHTMLElementCollection
    
        Set XmlHttp = New MSXML2.ServerXMLHTTP60
        Set Stream = New ADODB.Stream
        Set Document = New MSHTML.HTMLDocument
    #Else
        Dim XmlHttp         As Object
        Dim Stream          As Object
        Dim Document        As Object
        Dim Scripts         As Object
        Dim Script          As Object
        Dim Tables          As Object
        Dim Table           As Object
        Dim Rows            As Object
        Dim Row             As Object
        Dim Fields          As Object
        
        Set XmlHttp = CreateObject("MSXML2.ServerXMLHTTP")
        Set Stream = CreateObject("ADODB.Stream")
        Set Document = CreateObject("htmlfile")
    #End If
    
        Static Rates()      As Variant
        Static LastCall     As Date
        Static LastCode     As String
        
        Dim ServiceUrl      As String
        Dim RateCount       As Integer
        Dim Published       As String
        Dim ValueDate       As Date
        Dim ThisCall        As Date
        Dim Text            As String
        Dim Index           As Integer
        Dim Unit            As Double
        Dim ScaledRate      As Double
        Dim TrueRate        As Double
        
        If StrComp(LanguageCode, RussianCode, vbTextCompare) = 0 Then
            LanguageCode = RussianCode
            ServiceUrl = RuServiceUrl
        Else
            LanguageCode = EnglishCode
            ServiceUrl = EnServiceUrl
        End If
        
        If LastCode = LanguageCode And DateDiff("h", LastCall, UtcNow) < UpdatePause Then
            ' Return cached rates.
        Else
            ' Retrieve updated rates.
        
            ' Define default result array.
            ' Redim for four dimensions: date, code, rate, name.
            ReDim Rates(0, 0 To 3)
            Rates(0, RateDetail.Date) = NoValueDate
            Rates(0, RateDetail.Code) = NeutralCode
            Rates(0, RateDetail.Rate) = NeutralRate
            Rates(0, RateDetail.Name) = NeutralName
            
            ' Retrieve data.
            XmlHttp.Open "GET", ServiceUrl, Async
            XmlHttp.Send
            If XmlHttp.Status = HttpStatus.OK Then
                ' Retrieve and convert the page.
                ' The default character set cannot be used. See:
                ' https://stackoverflow.com/a/23812869/3527297
                
                ' Write the raw bytes to the stream.
                Stream.Open
                Stream.Type = adTypeBinary
                Stream.Write XmlHttp.responseBody
                ' Read text characters from the stream applying the character set.
                Stream.Position = 0
                Stream.Type = adTypeText
                Stream.Charset = Characterset
                ' Copy the page to the document object.
                Document.body.innerHTML = Stream.ReadText
            
                ' Search the scripts to locate the publishing date.
                Set Scripts = Document.getElementsByTagName("script")
                ValueDate = Date
                For Each Script In Scripts
                    Text = Script.innerHTML
                    If InStr(Text, "uniDbQuery_Data =") > 0 Then
                        Published = Left(Split(Text, DateHeader)(1), DateLength)
                        If IsDate(Published) Then
                            ValueDate = CDate(Published)
                        End If
                        Exit For
                    End If
                Next
            
                ' Search the tables to locate the data table.
                ' Doesn't work with late binding.
                ' Set Tables = Document.getElementsByClassName("data")
                Set Tables = Document.getElementsByTagName("table")
                For Each Table In Tables
                    If Table.className = DataClassName Then
                        Exit For
                    End If
                Next
                
                If Not Table Is Nothing Then
                    ' The table was found.
                    Set Rows = Table.getElementsByTagName("tr")
                    ' Reduce the count by one to skip the header row.
                    RateCount = Rows.Length - 1
                    ' Redim for four dimensions: date, code, rate, name.
                    ReDim Rates(0 To RateCount - 1, 0 To 3)
                    
                    ' Fill the array of rates.
                    For Index = LBound(Rates, 1) To UBound(Rates, 1)
                        ' Offset Index by one to skip the header row.
                        Set Row = Rows.Item(Index + 1)
                        ' Get the fields of this rate.
                        Set Fields = Row.getElementsByTagName("td")
                        
                        ' The returned rates are scaled to hold four decimals only.
                        ' Calculate the true (non-scaled) rate.
                        ScaledRate = Val(Replace(Fields.Item(RateField).innerText, ",", "."))
                        Unit = Val(Fields.Item(UnitField).innerText)
                        TrueRate = ScaledRate / Unit
                        
                        Rates(Index, RateDetail.Date) = ValueDate
                        Rates(Index, RateDetail.Code) = Fields.Item(CodeField).innerText
                        Rates(Index, RateDetail.Rate) = TrueRate
                        Rates(Index, RateDetail.Name) = Fields.Item(NameField).innerHTML
                    Next
                End If
                
                ThisCall = ValueDate + UpdateHour
                ' Record requested language and publishing time of retrieved rates.
                LastCode = LanguageCode
                LastCall = ThisCall
                
            End If
        End If
        
        ExchangeRatesCbr = Rates
    
    End Function 
    

    The associated CurrencyConvertCbr function is nearly identical to the one already listed, so I won't list it here.

    相关的CurrencyConvertCbr函数与已经列出的函数几乎相同,因此在此不再列出。

    4.货币转换器API (4. Currency Converter API)

    Contrary to the other services, this on supplies only one or a few specified exchange rates. For this reason - and, again, to avoid repeated calls for the same information - the retrieved exchange rates are collected in a collection. Further, for simplicity, our code will only retrieve one exchange rate per call. 

    与其他服务相反,此服务仅提供一个或几个指定汇率。 因此,并且为了避免重复调用相同的信息,将取回的汇率收集在collection中 。 此外,为简单起见,我们的代码每次调用将仅检索一种汇率。

    This means that if you, for example, wish to have the exchange rates for USD, RUB, and DKK against EUR, you will make three calls and, for each call, add the retrieved exchange rate information to the collection, thus "building up" the array of exchange rates returned.

    这意味着,例如,如果您希望拥有USD,RUB和DKK对EUR的汇率,您将进行三个调用,并针对每个调用将检索到的汇率信息添加到集合中,从而“建立返回的汇率数组。

    Each step is carefully commented in-line to make it easy to follow the flow. Note please, that the Json data is retrieved and decoded by the functions RetrieveDataResponse and CollectJson  from my project VBA.CVRAPI (link above):

    每个步骤都经过仔细的在线注释,以使其易于遵循流程。 请注意,Json数据是通过RetrieveDataResponseCollectJson函数从我的项目VBA.CVRAPI中检索和解码的(上面的链接):

    ' Retrieve the current exchange rate from "Currency Converter API" for one base currency.
    ' The requested rate is returned as an array and cached until the next update.
    ' All retrieved rates are cached in a collection until the next update.
    ' The rates are updated from once per hour down to once per minute.
    '
    ' Default base currency is EUR.
    ' Default rate is for USD.
    '
    ' Source:
    '   https://currencyconverterapi.com/
    '   https://currencyconverterapi.com/docs
    '
    ' Note:
    '   The services are provided as is and without warranty.
    '
    ' Example:
    '   Dim Rates As Variant
    '   Rates = ExchangeRatesCca()
    '   Rates(0, 0) -> 2018-09-24 07:56:50  ' Publishing date.
    '   Rates(0, 1) -> "USD"                ' Currency code.
    '   Rates(0, 2) -> 1.17395              ' Exchange rate.
    '
    ' 2018-09-24. Gustav Brock, Cactus Data ApS, CPH.
    '
    Public Function ExchangeRatesCca( _
        Optional ByVal IsoBase As String = EuroCode, _
        Optional ByVal IsoTo As String = USDollarCode) _
        As Variant
        
        ' Operational constants.
        '
        ' API endpoint.
        Const FreeSubdomain As String = "free"
        Const PaidSubdomain As String = "api"
        Const TempSubdomain As String = "xxx"
        ' API version must be 3 or higher.
        Const ApiVersion    As String = "6"
        Const ServiceUrl    As String = "https://" & TempSubdomain & ".currencyconverterapi.com/api/v" & ApiVersion & "/convert"
        ' Data styles. For reference only; must be "ultra".
        Const CompactStyle  As String = "ultra"
        Const ExtendedStyle As String = ""
        ' Update interval: 60, 15, or 1 minutes.
        Const UpdatePause   As Integer = 60
        
        ' Function constants.
        '
        ' Default currency code. Can be any valid currency codes.
        Const DefaultBase   As String = EuroCode
        Const DefaultTo     As String = USDollarCode
        ' Node names in retrieved collection.
        Const RootNodeName  As String = "root"
        ' ResponseText when invalid currency code is passed.
        Const EmptyResponse As String = "{}"
        
        Static CodePairs    As Collection
        
        Static Rates()      As Variant
        Static LastCodePair As String
        Static LastCall     As Date
        
        Dim DataCollection  As Collection
        
        Dim Parameter()     As String
        Dim Parameters()    As String
        Dim UrlParts(1)     As String
        
        Dim Subdomain       As String
        Dim CodePair        As String
        Dim RateItem        As Variant
        Dim Index           As Integer
        Dim Url             As String
        Dim ResponseText    As String
        Dim ValueDate       As Date
        Dim ThisCall        As Date
        Dim IsCurrent       As Boolean
        
        ' Assemple code pair.
        If IsoBase = "" Then
            IsoBase = DefaultBase
        End If
        If IsoTo = "" Then
            IsoTo = DefaultTo
        End If
        CodePair = Trim(Left(UCase(IsoBase), 3)) & "_" & Trim(Left(UCase(IsoTo), 3))
        
        ' Is the current collection of rates up-to-date?
        IsCurrent = DateDiff("n", LastCall, Now) < UpdatePause
        
        If IsCurrent And LastCodePair = CodePair Then
            ' Return cached rate.
        ElseIf IsCurrent And IsCollectionItem(CodePairs, CodePair) Then
            ' Return stored rate from collection.
            Rates = CodePairs(CodePair)
            LastCodePair = CodePair
        Else
            ' Retrieve the code pair and add it to the collection of code pairs.
            If IsCurrent Then
                ' Keep the stored code pairs.
            Else
                ' Clear all stored code pairs.
                Set CodePairs = New Collection
            End If
            
            ' Set subdomain to call.
            If CcaApiId = "" Then
                ' Free plan is used.
                Subdomain = FreeSubdomain
            Else
                ' Paid plan is used.
                Subdomain = PaidSubdomain
            End If
            
            ' Define parameter array.
            ' Redim for two dimensions: name, value.
            ReDim Parameter(0 To 2, 0 To 1)
            ' Parameter names.
            Parameter(0, ParameterDetail.Name) = "q"
            Parameter(1, ParameterDetail.Name) = "compact"
            Parameter(2, ParameterDetail.Name) = "apiKey"
            ' Parameter values.
            Parameter(0, ParameterDetail.Value) = CodePair
            Parameter(1, ParameterDetail.Value) = CompactStyle
            Parameter(2, ParameterDetail.Value) = CcaApiId
            
            ' Assemble parameters.
            ReDim Parameters(LBound(Parameter, 1) To UBound(Parameter, 1))
            For Index = LBound(Parameters) To UBound(Parameters)
                Parameters(Index) = Parameter(Index, 0) & "=" & Parameter(Index, 1)
            Next
            
            ' Assemble URL.
            UrlParts(0) = Replace(ServiceUrl, TempSubdomain, Subdomain)
            UrlParts(1) = Join(Parameters, "&")
            Url = Join(UrlParts, "?")
            ' Uncomment for debugging.
            'Debug.Print Url
            
            ' Define default result array.
            ' Redim for three dimensions: date, code, rate.
            ReDim Rates(0, 0 To 2)
            Rates(0, RateDetail.Date) = NoValueDate
            Rates(0, RateDetail.Code) = NeutralCode
            Rates(0, RateDetail.Rate) = NeutralRate
            
            If RetrieveDataResponse(Url, ResponseText) = True Then
                Set DataCollection = CollectJson(ResponseText)
            End If
        
            If DataCollection Is Nothing Then
                ' Error. ResponseText holds the error code.
                ' Optional error handling.
                Select Case ResponseText
                    Case HttpStatus.BadRequest
                        ' Typical for invalid api key, or API limit reached.
                    Case EmptyResponse
                        ' Invalid currency code.
                    Case Else
                        ' Other error.
                End Select
                ' Set "not found" return values.
                Rates(0, RateDetail.Code) = NoCode
                Rates(0, RateDetail.Rate) = NoRate
            End If
            
            If Not DataCollection Is Nothing Then
                ' The rate was retrieved.
                ' Get the UTC value date and time for the rate.
                ValueDate = UtcNow
                
                ' The retrieved rate item is an array.
                RateItem = DataCollection(RootNodeName)(CollectionItem.Data)(1)
                Rates(0, RateDetail.Date) = ValueDate
                Rates(0, RateDetail.Code) = Split(RateItem(CollectionItem.Name), "_")(1)
                Rates(0, RateDetail.Rate) = RateItem(CollectionItem.Data)
                
                ' Store this code pair in the collection of code pairs.
                CodePairs.Add Rates, CodePair
                
                Set DataCollection = Nothing
                
                ' Round the call time down to the start of the update interval.
                ThisCall = CDate(Fix(Now * 24 * 60 / UpdatePause) / (24 * 60 / UpdatePause))
                ' Record hour of retrieval.
                LastCall = ThisCall
            End If
            ' Record requested base currency.
            LastCodePair = CodePair
        End If
        
        ExchangeRatesCca = Rates
    
    End Function 
    

    As the exchange rates are collected pair-wise in the collection, the corresponding CurrencyConvertCca is extremely simple:

    由于汇率是成对收集的,因此相应的CurrencyConvertCca非常简单:

    ' Returns the current conversion factor from one currency to another
    ' based on the exchange rates published by "Currency Converter API".
    ' By default, conversion is from Euro to another currency.
    '
    ' If an invalid or unpublished currency code is passed, a conversion factor
    ' of zero is returned.
    '
    ' Examples, typical:
    '   CurrencyConvertCca("DKK")           ->  7.47139
    '   CurrencyConvertCca("DKK", "EUR")    ->  7.47139
    '   CurrencyConvertCca("AUD")           ->  1.61313
    '   CurrencyConvertCca("AUD", "DKK")    ->  0.215908
    '   CurrencyConvertCca("DKK", "AUD")    ->  4.63161
    '   CurrencyConvertCca("EUR", "DKK")    ->  0.133844
    '   CurrencyConvertCca("", "DKK")       ->  0.157527
    '   CurrencyConvertCca("USD")           ->  1.176948
    ' Examples, neutral code.
    '   CurrencyConvertCca("AUD", "XXX")    ->  1
    '   CurrencyConvertCca("XXX", "AUD")    ->  1
    '   CurrencyConvertCca("XXX")           ->  1
    ' Examples, invalid code.
    '   CurrencyConvertCca("XYZ")           ->  0
    '   CurrencyConvertCca("DKK", "XYZ")    ->  0
    '
    ' 2018-09-24. Gustav Brock, Cactus Data ApS, CPH.
    '
    Public Function CurrencyConvertCca( _
        ByVal IsoTo As String, _
        Optional ByVal IsoFrom As String = EuroCode) _
        As Double
        
        Dim Rates()     As Variant
        
        Dim IsoBase     As String
        Dim Factor      As Double
        
        If IsoFrom = "" Then
            IsoFrom = EuroCode
        End If
        If IsoTo = "" Then
            IsoTo = USDollarCode
        End If
        
        If IsoTo = NeutralCode Or IsoFrom = NeutralCode Then
            Factor = NeutralRate
        ElseIf IsoTo = IsoFrom Then
            Factor = NeutralRate
        Else
            ' Retrieve the current rate.
            IsoBase = IsoFrom
            Rates() = ExchangeRatesCca(IsoBase, IsoTo)
            Factor = Rates(0, RateDetail.Rate)
        End If
        
        CurrencyConvertCca = Factor
    
    End Function 
    

    5. Currencylayer API (5. Currencylayer API)

    6. ExchangeRate API (6. ExchangeRate API)

    7.固定器 (7. Fixer)

    8.开放汇率 (8. Open Exchange Rates)

    9. php.mk-北马其顿共和国国家银行 (9. php.mk - National Bank of the Republic of North Macedonia)

    These five services supply the exchange rates as Json data. However, the formats of the four sets of data - as well as the formats of the URL to request these, and the possible error codes - are all different, thus individualised functions are needed to retrieve the exchange rates.

    这五个服务将汇率作为Json数据提供。 但是,四组数据的格式以及请求这些格式的URL的格式以及可能的错误代码都不同,因此需要个性化的功能来检索汇率。

    That said, they are quite similar, so we will only list one here. Note please, that - for free - only ExchangeRate API offers exchanges rates for any base currency, thus - for the four others - the exchange rates for other base currencies then the fixed one, triangular calculation is implemented to still obtain useful exchange rates using a free plan/subscription. 

    也就是说,它们非常相似,因此我们仅在此处列出一个。 请注意,(免费)只有ExchangeRate API提供任何基础货币的汇率,因此-对于其他四种-其他基础货币的汇率,则采用固定的一种三角计算 ,以仍然使用免费计划/订阅。

    Other than that, the steps followed are similar to the other ExchangeRatesXyz function.

    除此之外,遵循的步骤与其他ExchangeRatesXyz函数相似。

    Note the second call to the service, in case an "invalid" base currency is passed - which will be the case using the free plan and a base currency other than the fixed:

    请注意第二次调用该服务,以防万一传递了“无效”基础货币-使用免费计划和固定货币以外的基础货币时,情况会如此:

    ' Retrieve the current exchange rates from "Currencylayer API" for one base currency.
    ' The rates are returned as an array and cached until the next update.
    ' The rates are updated from once per hour down to once per minute.
    '
    ' Default base currency is USD.
    ' For the free plan, exchange rates for other base currencies are
    ' calculated from USD by triangular calculation.
    '
    ' Source:
    '   https://currencylayer.com/
    '   https://currencylayer.com/documentation
    '
    ' Note:
    '   Exchange rates are classed as indicative rates and are accurate enough to display price estimations.
    '   The rates are unsuitable for forex trading or processing cross currency settlements.
    '
    ' Example:
    '   Dim Rates As Variant
    '   Rates = ExchangeRatesCla()
    '   Rates(12, 0) -> 2018-09-20 08:54:06 ' Publishing date.
    '   Rates(12, 1) -> "BDT"               ' Currency code.
    '   Rates(12, 2) -> 84.064038           ' Exchange rate.
    '
    ' 2018-10-07. Gustav Brock, Cactus Data ApS, CPH.
    '
    Public Function ExchangeRatesCla( _
        Optional ByVal IsoBase As String) _
        As Variant
        
        ' Operational constants.
        '
        ' API endpoint for the free plan.
        ' For the paid plans, https may be used.
        Const ServiceUrl    As String = "http://www.apilayer.net/api/live"
        ' Update interval: 60, 10, or 1 minutes.
        Const UpdatePause   As Integer = 60
        
        ' Function constants.
        '
        ' Default base currency code.
        Const DefaultBase   As String = USDollarCode
        ' Node names in retrieved collection.
        Const RootNodeName  As String = "root"
        Const TimeNodeName  As String = "timestamp"
        Const RateNodeName  As String = "quotes"
        Const FirstNodeName As String = "success"
        Const ErrorNodeName As String = "error"
        Const CodeNodeName  As String = "code"
        ' Error code for invalid or missing access key.
        Const KeyErrorCode  As Long = 101
        ' Error code for restricted access to base currency.
        Const BaseErrorCode As Long = 105
        ' Error code for invalid currency code.
        Const CodeErrorCode As Long = 201
        
        Static Rates()      As Variant
        Static LastCode     As String
        Static LastCall     As Date
        
        Dim DataCollection  As Collection
        
        Dim Parameters()    As String
        Dim Parameter()     As String
        Dim UrlParts(1)     As String
        
        Dim RateCount       As Integer
        Dim RateItem        As Variant
        Dim BaseRate        As Double
        Dim Index           As Integer
        Dim Url             As String
        Dim ResponseText    As String
        Dim ValueDate       As Date
        Dim ThisCall        As Date
        Dim ErrorCode       As Long
        
        If IsoBase = "" Then
            IsoBase = DefaultBase
        End If
        
        If LastCode = IsoBase And DateDiff("n", LastCall, Now) < UpdatePause Then
            ' Return cached rates.
        Else
            ' Retrieve updated rates.
            
            ' Define parameter array.
            ' Redim for two dimensions: name, value.
            ReDim Parameter(0 To 1, 0 To 1)
            ' Parameter names.
            Parameter(0, ParameterDetail.Name) = "access_key"
            Parameter(1, ParameterDetail.Name) = "source"
            ' Parameter values.
            Parameter(0, ParameterDetail.Value) = ApiApiId
            Parameter(1, ParameterDetail.Value) = IsoBase
            
            ' Assemble parameters.
            ReDim Parameters(LBound(Parameter, 1) To UBound(Parameter, 1))
            For Index = LBound(Parameters) To UBound(Parameters)
                Parameters(Index) = Parameter(Index, 0) & "=" & Parameter(Index, 1)
            Next
            
            ' Assemble URL.
            UrlParts(0) = ServiceUrl
            UrlParts(1) = Join(Parameters, "&")
            Url = Join(UrlParts, "?")
            ' Uncomment for debugging.
            ' Debug.Print Url
            
            ' Define default result array.
            ' Redim for three dimensions: date, code, rate.
            ReDim Rates(0, 0 To 2)
            Rates(0, RateDetail.Date) = NoValueDate
            Rates(0, RateDetail.Code) = NeutralCode
            Rates(0, RateDetail.Rate) = NeutralRate
            
            If RetrieveDataResponse(Url, ResponseText) = True Then
                Set DataCollection = CollectJson(ResponseText)
            Else
                ' Give up.
                Set DataCollection = Nothing
            End If
        
            If Not DataCollection Is Nothing Then
                If DataCollection(RootNodeName)(CollectionItem.Data)(1)(CollectionItem.Name) = FirstNodeName Then
                    If DataCollection(RootNodeName)(CollectionItem.Data)(FirstNodeName)(CollectionItem.Data) = False Then
                        ErrorCode = DataCollection(RootNodeName)(CollectionItem.Data)(ErrorNodeName)(CollectionItem.Data)(CodeNodeName)(CollectionItem.Data)
                        Select Case ErrorCode
                            Case KeyErrorCode
                                ' Missing or invalid access key.
                                Set DataCollection = Nothing
                            Case CodeErrorCode, BaseErrorCode
                                ' Typical for invalid currency code, or if free license and base <> USD, respectively.
                                ' Rebuld Url to use base = USD.
                                Parameter(1, 1) = DefaultBase
                                ' Reassemble parameters.
                                For Index = LBound(Parameters) To UBound(Parameters)
                                    Parameters(Index) = Parameter(Index, 0) & "=" & Parameter(Index, 1)
                                Next
                                
                                ' Reassemble URL.
                                UrlParts(0) = ServiceUrl
                                UrlParts(1) = Join(Parameters, "&")
                                Url = Join(UrlParts, "?")
                                
                                ' Try once more to retrieve the rates.
                                If RetrieveDataResponse(Url, ResponseText) = True Then
                                    Set DataCollection = CollectJson(ResponseText)
                                    If DataCollection(RootNodeName)(CollectionItem.Data)(FirstNodeName)(CollectionItem.Data) = False Then
                                        ' Give up.
                                        Set DataCollection = Nothing
                                    End If
                                End If
                                ' Rebuld Url to use base = USD.
                                Parameter(1, 1) = DefaultBase
                                ' Reassemble parameters.
                                For Index = LBound(Parameters) To UBound(Parameters)
                                    Parameters(Index) = Parameter(Index, 0) & "=" & Parameter(Index, 1)
                                Next
                                
                                ' Reassemble URL.
                                UrlParts(0) = ServiceUrl
                                UrlParts(1) = Join(Parameters, "&")
                                Url = Join(UrlParts, "?")
                                
                                ' Try once more to retrieve the rates.
                                If RetrieveDataResponse(Url, ResponseText) = True Then
                                    Set DataCollection = CollectJson(ResponseText)
                                    If DataCollection(RootNodeName)(CollectionItem.Data)(FirstNodeName)(CollectionItem.Data) = False Then
                                        ' Give up.
                                        Set DataCollection = Nothing
                                    End If
                                End If
                        End Select
                    End If
                End If
            End If
            
            If Not DataCollection Is Nothing Then
                ' Rates were retrieved.
                ' Get the UTC value date and time for the rates.
                ValueDate = DateUnix(DataCollection(RootNodeName)(CollectionItem.Data)(TimeNodeName)(CollectionItem.Data))
                ' Get count of rates.
                RateCount = DataCollection(RootNodeName)(CollectionItem.Data)(RateNodeName)(CollectionItem.Data).Count
                ' Redim for three dimensions: date, code, rate.
                ReDim Rates(RateCount - 1, 0 To 2)
                BaseRate = NeutralRate
        
                ' Fill the array from the collection items.
                For Index = 1 To RateCount
                    ' A retrieved rate item is an array.
                    RateItem = DataCollection(RootNodeName)(CollectionItem.Data)(RateNodeName)(CollectionItem.Data)(Index)
                    Rates(Index - 1, RateDetail.Date) = ValueDate
                    Rates(Index - 1, RateDetail.Code) = Right(RateItem(CollectionItem.Name), 3)
                    Rates(Index - 1, RateDetail.Rate) = RateItem(CollectionItem.Data)
                    If Right(RateItem(CollectionItem.Name), 3) = IsoBase And RateItem(CollectionItem.Data) <> NeutralRate Then
                        ' Prepare triangular calculation.
                        BaseRate = RateItem(CollectionItem.Data)
                    End If
                Next
                If BaseRate <> NeutralRate Then
                    For Index = 1 To RateCount
                        ' Perform triangular calculation of the exchange rates.
                        If Rates(Index - 1, RateDetail.Code) = IsoBase Then
                            Rates(Index - 1, RateDetail.Rate) = NeutralRate
                        Else
                            Rates(Index - 1, RateDetail.Rate) = Rates(Index - 1, RateDetail.Rate) / BaseRate
                        End If
                    Next
                End If
                
                Set DataCollection = Nothing
                
                ' Round the call time down to the start of the update interval.
                ThisCall = CDate(Fix(Now * 24 * 60 / UpdatePause) / (24 * 60 / UpdatePause))
                ' Record requested base currency and hour of retrieval.
                LastCode = IsoBase
                LastCall = ThisCall
            End If
        End If
        
        ExchangeRatesCla = Rates
    
    End Function 
    

    The matching ConvertCurrencyXyz functions are similar to the first listed above, so please go to the code to study the minor differences.

    匹配的ConvertCurrencyXyz函数类似于上面列出的第一个函数,因此请转到代码以研究较小的差异。

    10. XE (10. XE)

    The API of the XE service is extended compared to the other services - for example, are average exchange rates for a period offered. That comes for a price, as no free plan is offered. If you only wish to check it out, obtain a free trial, and you have seven days; from then on, you'll have to pay.

    与其他服务相比,XE服务的API有所扩展-例如,所提供时间段内的平均汇率。 这是有代价的,因为没有提供免费计划。 如果您只想检查一下,请获得免费试用,并且您有7天的时间; 从那时起,您将需要付费。

    Due to the complexity of the API, our ExchangeRatesXec function is slightly extended compared to the other functions handling Json data, because the retrieved data contains not only exchange rates but sets of exchange rates for each currency. To make the function comparable to the other ExchangeRateXyz functions, we only deal with the mid-market rates, but still.

    由于API的复杂性,我们ExchangeRatesXec功能略有延长相对于其他功能处理JSON数据,因为检索到的数据不仅包含各种货币兑换汇率的利率,但 。 为了使该功能与其他ExchangeRateXyz功能具有可比性,我们仅处理中端市场汇率,但仍然如此。

    Anyway, if you have the budget and a need for some of the more special options and offerings from XE, the function here will provide a good starting point.

    无论如何,如果您有预算并且需要XE的一些更特殊的选项和产品,则此处的功能将为您提供一个良好的起点。

    As for the other functions, the in-line comments will guide you through the steps taken:

    至于其他功能,在线注释将指导您完成以下步骤:

    ' Retrieve the current exchange rates from "XE" for one base currency.
    ' The rates are returned as an array and cached until the next update.
    ' The rates are updated from once per day down to once per minute.
    '
    ' Default base currency is USD.
    '
    ' Source:
    '   https://www.xe.com/
    '   https://www.xe.com/xecurrencydata/
    '
    ' Note:
    '   Exchange rates are live mid-market rates, which are not available to
    '   consumers and are for informational purposes only.
    '
    ' Example:
    '   Dim Rates As Variant
    '   Rates = ExchangeRatesXec()
    '   Rates(12, 0) -> 2018-10-12 00:00:00 ' Publishing date.
    '   Rates(12, 1) -> "BDT"               ' Currency code.
    '   Rates(12, 2) -> 83.7886823907       ' Exchange rate.
    '
    ' 2018-10-16. Gustav Brock, Cactus Data ApS, CPH.
    '
    Public Function ExchangeRatesXec( _
        Optional ByVal IsoBase As String) _
        As Variant
        
        ' Operational constants.
        '
        ' API endpoint.
        Const ServiceUrl    As String = "https://xecdapi.xe.com/v1/convert_from/"
        ' Update interval: 60, 30, or 5 minutes.
        Const UpdatePause   As Integer = 60
        
        ' Function constants.
        '
        ' Default base currency code.
        Const DefaultBase   As String = USDollarCode
        ' Node names in retrieved collection.
        Const RootNodeName  As String = "root"
        Const TimeNodeName  As String = "timestamp"
        Const RateNodeName  As String = "to"
        Const CodeNodeName  As String = "quotecurrency"
        Const ValueNodeName As String = "mid"
        
        Static Rates()      As Variant
        Static LastCode     As String
        Static LastCall     As Date
        
        Dim DataCollection  As Collection
        
        Dim Parameter()     As String
        Dim Parameters()    As String
        Dim UrlParts(1)     As String
        
        Dim UserName        As String
        Dim Password        As String
        
        Dim RateCount       As Integer
        Dim RateItem        As Variant
        Dim BaseRate        As Double
        Dim Index           As Integer
        Dim Url             As String
        Dim ResponseText    As String
        Dim ValueDate       As Date
        Dim ThisCall        As Date
        
        If IsoBase = "" Then
            IsoBase = DefaultBase
        End If
        
        If LastCode = IsoBase And DateDiff("n", LastCall, UtcNow) < UpdatePause Then
            ' Return cached rates.
        Else
            ' Retrieve updated rates.
            
            ' Define parameter array.
            ' Redim for two dimensions: name, value.
            ReDim Parameter(0 To 1, 0 To 1)
            ' Parameter names.
            Parameter(0, ParameterDetail.Name) = "from"
            Parameter(1, ParameterDetail.Name) = "to"
            ' Parameter values.
            Parameter(0, ParameterDetail.Value) = IsoBase
            Parameter(1, ParameterDetail.Value) = "*"
            
            ' Assemble parameters.
            ReDim Parameters(LBound(Parameter, 1) To UBound(Parameter, 1))
            For Index = LBound(Parameters) To UBound(Parameters)
                Parameters(Index) = Parameter(Index, 0) & "=" & Parameter(Index, 1)
            Next
            
            ' Assemble URL.
            UrlParts(0) = ServiceUrl
            UrlParts(1) = Join(Parameters, "&")
            Url = Join(UrlParts, "?")
            ' Uncomment for debugging.
             Debug.Print Url
            
            ' Credentials.
            UserName = XeAccount
            Password = XeApiId
            
            ' Define default result array.
            ' Redim for three dimensions: date, code, rate.
            ReDim Rates(0, 0 To 2)
            Rates(0, RateDetail.Date) = NoValueDate
            Rates(0, RateDetail.Code) = NeutralCode
            Rates(0, RateDetail.Rate) = NeutralRate
                    
            If RetrieveDataResponse(Url, ResponseText, , UserName, Password) = True Then
                Set DataCollection = CollectJson(ResponseText)
            Else
                ' Check error codes.
                Select Case Left(ResponseText, 3)
                    Case HttpStatus.Forbidden
                        ' Invalid credentials.
                    Case HttpStatus.BadRequest
                        ' Invalid currency code (typical).
                End Select
                ' No rates were received.
                Set DataCollection = Nothing
            End If
        
            If Not DataCollection Is Nothing Then
                ' Rates were retrieved.
                ' Get the UTC value date and time for the rates.
                ValueDate = DateIso8601(DataCollection(RootNodeName)(CollectionItem.Data)(TimeNodeName)(CollectionItem.Data))
                ' Get count of rates.
                RateCount = DataCollection(RootNodeName)(CollectionItem.Data)(RateNodeName)(CollectionItem.Data).Count
                ' Redim for three dimensions: date, code, rate.
                ReDim Rates(RateCount - 1, 0 To 2)
                BaseRate = NeutralRate
        
                ' Fill the array from the collection items.
                For Index = 1 To RateCount
                    ' A retrieved rate item is yet a collection with an array.
                    RateItem = DataCollection(RootNodeName)(CollectionItem.Data)(RateNodeName)(CollectionItem.Data)(Index)
                    Rates(Index - 1, RateDetail.Date) = ValueDate
                    Rates(Index - 1, RateDetail.Code) = RateItem(CollectionItem.Data)(CodeNodeName)(CollectionItem.Data)
                    Rates(Index - 1, RateDetail.Rate) = RateItem(CollectionItem.Data)(ValueNodeName)(CollectionItem.Data)
                Next
                
                Set DataCollection = Nothing
                
                ' Round the call time down to the start of the update interval.
                ThisCall = CDate(Fix(Now * 24 * 60 / UpdatePause) / (24 * 60 / UpdatePause))
                ' Record requested base currency and hour of retrieval.
                LastCode = IsoBase
                LastCall = ThisCall
            End If
        End If
        
        ExchangeRatesXec = Rates
    
    End Function 
    

    The accompanying CurrencyConvertXec function is similar to the other CurrencyConvertXyz functions, so I won't list it here.

    随附的CurrencyConvertXec函数与其他CurrencyConvertXyz函数类似,因此在此不再列出。

    配套功能 (Supporting functions)

    A few trivial supporting date functions are used in some of the exchange rate functions. They will not be listed here, but can all be found in the supplemental modules included in the repository and the attached demo application.

    一些汇率函数中使用了一些琐碎的支持日期函数。 它们不会在此处列出,但是都可以在存储库和随附的演示应用程序中包含的补充模块中找到。

    储存汇率 (Storing exchange rates)

    In many cases, you will simply wish to maintain a table with current (and past) exchange rates.

    在许多情况下,您仅希望维护一个包含当前(和过去)汇率的表格。

    This can easily be done - using the array of rates returned from any of the ExchangeRatesXyz functions.

    这很容易完成-使用从任何ExchangeRatesXyz函数返回的汇率数组。

    A simple function, that demonstrates this, is included - either to be used as is or for a starting point:

    包含一个简单的函数来演示这一点-可以按原样使用或用作起点:

    ' CurrencyExchange Demo V1.0.0
    ' (c) Gustav Brock, Cactus Data ApS, CPH
    
    
    ' Fill table CurrencyRate with exchange rates from a source of choice.
    '
    ' Example:
    '
    '   FillCurrencyRates ExchangeRatesDkk
    '
    ' Note, that some sources don't supply the currency name, only the code.
    '
    ' 2018-10-07. Gustav Brock, Cactus Data ApS, CPH.
    '
    Public Sub FillCurrencyRates(ByRef Rates As Variant)
    
        Const TableName     As String = "CurrencyRate"
        
        Dim Records         As DAO.Recordset
        
        Dim FieldNames      As Variant
        Dim Sql             As String
        Dim Index           As Integer
        Dim Item            As Integer
        
        If Not IsArray(Rates) Then Exit Sub
        
        ' Field names must match the order of array Rates.
        FieldNames = Array("[Date]", "[Code]", "[Rate]", "[Name]")
        
        ' Clean table.
        Sql = "Delete * From " & TableName & ";"
        CurrentDb.Execute Sql
        
        ' Fill table.
        Sql = "Select " & Join(FieldNames, ",") & " From " & TableName & ";"
        Set Records = CurrentDb.OpenRecordset(Sql)
        For Index = LBound(Rates, 1) To UBound(Rates, 1)
            Records.AddNew
            For Item = LBound(Rates, 2) To UBound(Rates, 2)
                Records.Fields(Item).Value = Rates(Index, Item)
            Next
            Records.Update
        Next
        Records.Close
        
    End Sub 
    

    A table for the purpose, CurrencyRate, is included as well for you to check out.

    还包括一个目的表CurrencyRate ,供您签出。

    结论 (Conclusion)

    Extensive code has been provided for retrieving, using, and storing currency exchange rates from nine different sources - some free, some paid - using three basic methods for reading data off the internet.

    提供了广泛的代码,用于使用三种基本方法从Internet上读取,检索和使用九种不同来源的货币汇率,其中一些是免费的,有些是付费的。

    As more services may become available, it should be easy to modify one or more of these functions to match a new service. 

    随着更多服务的可用,应该容易地修改这些功能中的一个或多个功能以匹配新服务。

    进一步阅读 (Further reading)

    My previous article about currency may prove useful: ISO 4217 Currency Codes in VBA

    我以前有关货币的文章可能被证明是有用的: VBA中的ISO 4217货币代码

    代码模块和演示应用程序 (Code modules and demo application)

    Code has been tested with both 32-bit and 64-bit Microsoft Access 2019 and 365

    代码已通过32位和64位Microsoft Access 2019365进行了测试

    Please note, that it requires the Json modules from project VBA.CVRAPI.

    请注意,它需要项目VBA.CVRAPI中Json模块

    A demo in Microsoft Access 2019 is attached: CurrencyExchange 1.6.0.zip

    随附Microsoft Access 2019中的演示: CurrencyExchange 1.6.0.zip

    The current code can at any time be obtained from GitHub: VBA.CurrencyExchange

    当前代码可以随时从GitHub获得: VBA.CurrencyExchange

    I hope you found this article useful. You are encouraged to ask questions, report any bugs or make any other comments about it below.

    希望本文对您有所帮助。 鼓励您在下面提出问题,报告任何错误或对此作出任何其他评论。

    Note: If you need further "Support" about this topic, please consider using the Ask a Question feature of Experts Exchange. I monitor questions asked and would be pleased to provide any additional support required in questions asked in this manner, along with other EE experts.

    注意 :如果您需要有关此主题的更多“支持”,请考虑使用Experts Exchange 的“提问”功能。 我会监督提出的问题,并很高兴与其他电子工程师一起为以这种方式提出的问题提供所需的任何其他支持。

    Please do not forget to press the "Thumbs Up" button if you think this article was helpful and valuable for EE members.

    如果您认为本文对EE成员有用且有价值,请不要忘记按下“竖起大拇指”按钮。

    翻译自: https://www.experts-exchange.com/articles/33199/Exchange-Rates-and-Currency-Conversion-in-VBA.html

    vba 时间换算

    展开全文
  • VBA中变量和常量的命名规则

    万次阅读 2012-05-07 18:07:59
    Variable Naming Conventions You can call your variables and user-defined functions anything you want, except where there is a clash ...with VBA keywords and function names. However, many programmer
  • VBA 入门笔记

    千次阅读 2016-02-25 14:13:57
    去年刚刚学习VBA,总结一下入门知识,包括属性定义,选择判断循环等等。 Sub aa() MsgBox _ "学习 VBA ing" End Sub Sub 属性赋值() Sheet2.Name = "属性赋值" Sheet2.Range("b2") = "This is B2 cell" ...
  • VBA中的ColorIndex信息

    2021-04-19 23:53:38
    Color Palette, Excel (#chart) To see your 56 colors (to bring up box in VBA) In XL95 Help --> index --> Colorindex property In XL97/XL2000 VBE HELP (Alt+F11, F1) --> index --> ColorIndex property It...
  • VBA中的标识符,常量和变量

    千次阅读 2018-06-07 23:33:52
    标识符: 在程序运行的过程,通常需要将计算结果保存下来,在后面使用,程序使用的数据都保存在计算机...2、长度不能超过255个字符3、不能使用VBA的关键字4、同一个过程内不能使用重复的名称常量: 在程序运行...
  • VBA中使用计时器的两种方法

    千次阅读 2019-10-05 21:53:03
    '===============================...' VBA采用Application.OnTime实现计时器 ' ' http://www.cnhup.com '================================ Public RunWhen As Double Public Const cRunIntervalSeconds = 120...
  • 问题一:在VBA代码,如何引用当前工作表的单个单元格(例如引用单元格C3)? 回答:可以使用下面列举的任一方式对当前工作表的单元格(C3)进行引用。 (1) Range("C3") (2) [C3] (3) Cells(3, 3) ...
  • Excel VBA常数变量集合

    2011-04-07 15:02:33
    Excel VBA常数变量集合,部分示例如下: Public Const xlAll = &HFFFFEFF8 Public Const xlAutomatic = &HFFFFEFF7 Public Const xlBoth = 1 Public Const xlCenter = &HFFFFEFF4 Public Const xlChecker = 9 ...
  • VBA中的错误处理

    2019-09-25 07:11:08
    从理论上讲,VBA没有提供任何的错误处理机制,这种被用在微软Office产品的以Visual Basic语言为基础的脚本语言根本就不要任何的错误处理,当程序出现错误或产生异常情况时,VBA会自动定位到出错的代码行,然后提示...
  • VBA常量(八)

    2019-09-28 00:15:40
    常量是一个命名的内存位置,用于保存脚本执行期间固定(无法更改...常量名称不能在名称使用空格,句点(.),感叹号(!)或字符@,&,$,#。 常量名称的长度不能超过255个字符。 不能使用Visual Basic保留关键字作为...
  • 因为在Excel中VBA是默认隐藏且禁止运行宏的,所以首先介绍如何在Excel启用VBA,然后介绍基础的变量、常量与循环、判断语句
  • VBA中的彩色消息框

    千次阅读 2018-06-13 13:00:37
    VBA中显示消息框实在太简单了,一句MsgBox就可以了。 千篇一律的风格,不能漂亮一点儿吗?我们来给它点儿颜色看看,哈哈 Private Declare Function SetSysColors Lib &amp;quot;user32&amp;quot; ( _ ...
  • 需求描述 一份工作簿里面有5个表 将工作表1导出来成为一个单独的工作簿,命名1.xlsx 将工作表2导出来成为一个单独的工作...VBA Sub outputSheetAsWorkbook() Dim Wkb As Workbook Dim Sht As Worksheet Dim strPath
  • Hello,各位同学们大家好。前几次的VBA分享,在留言区收到了很多同学的实际需求。大家的支持,是我们持续分享的动力。这边会逐渐将大家的需求融进案例,也希望大家继续在留言区和我们分享你...
  • 要使包括 PtrSafe 的 Declare 语句能同时在 32 位和 64 位平台上的 VBA7 开发环境正确运行,必须先将 Declare 语句所有需要存储 64 位数的数据类型(参数和返回值)更新为使用 LongLong(对于 64 位整数)或 ...
  • Excel中VBA编程学习笔记(一)

    千次阅读 2018-11-25 16:45:29
    如果VB的关键字是由多个英文字母组成,则系统自动将每个单词的首字母转换成大写字母,其余字母一律转换成小写字母。 对于用户自定义的变量名、过程名、函数名,VB以第一次定义的为准,以后输入的自动转换成首次的...
  • 在word vba中Range、Selection 对象有多种移动、定位、选择文本内容的方法和属性。 在这些方法和属性,有两类枚举常量是经常要用到的,一类是移动、定位、选择的单位常量WdUnits,比如是按照行、段落、单词、还是...
  • Excel VBA中如何支持复数计算?

    千次阅读 2016-06-08 20:38:56
    内置built-in的WorkSheetFunction还是VBA函数都不支持复数类型。转一个Option Explicit Const pi = 3.14159265358979Type Complex re As Double im As Double End TypePublic Function AddComplex(a As Complex, b...
  •  1、先在PictureBox控件里画图,画好后将其加载到Listview  2、给单元格/Shape添加颜色后,复制Range和Shapes对象给剪贴板,然后保存成图片,需要WinAPI  3、通过thunk技术注入一段字节代码实现ListItem子类化...
  • vba常用方法

    2020-10-06 08:43:59
    Excel VBA常用代码总结1 做了几个月的Excel VBA,总结了一些常用的代码,我平时编程的时候参考这些代码,基本可以完成大部分的工作,现在共享出来供大家参考。 说明:本文为大大佐原创,但部分代码也是参考百度得...
  • excel2016 64bit的vba中使用API函数RegisterClass注册窗体类就Excel就崩溃!请问是怎么回事? ``` Option Explicit Public Declare PtrSafe Function RegisterClass Lib "user32" Alias "RegisterClassA" ...
  • 将Excel VBA封装成exe程序[老贴收藏]

    万次阅读 2019-09-17 16:23:22
    将Excel VBA封装成exe程序[老贴收藏] 假如您手头已有一xls文档等待封装,假如您机子上已安装有VB6开发系统,那么请跟着往下操作: 一、用VB制作EXE文件头部分 1、打开VB,“文件”-“新建工程”-“标准EXE”; 2...
  • VBA 批量生成 SQL

    2018-09-05 15:04:03
    在平常工作,有可能遇到这样的场景,Excel 里面的 N 多个数据需要导入到数据库,如果人工去拼接 SQL 会很麻烦,这时候写个简单的 VBA 函数就可以搞定了。 案例 假设我们有一个表,如下所示,需要导入到 MySQL ...
  • VBA快速合并字符串方法

    千次阅读 2020-12-23 02:16:44
    本文将就讲一下VBA中快速连接字符串的集中方法。 我们使用一个简单的示例,提取1-10的偶数并输出结果,判断偶数非常简单,程序主框架如下。 Sub Demo() Dim i As Integer, msg As String For i = 1 To 10 If ...

空空如也

空空如也

1 2 3 4 5 ... 20
收藏数 2,558
精华内容 1,023
关键字:

vba中的const