时间戳

首页 > 解决方案 > VBA：在类模块中模拟 AddressOf 运算符的解决方法

excel - VBA：在类模块中模拟 AddressOf 运算符的解决方法

问题描述

我需要Windows API在我正在开发的一个类中使用几个函数来完成一个爱好项目。其中一些功能需要使用AddressOf运算符，但根据Microsoft 文档，禁止在类模块中使用它。

有谁知道可以模拟AddressOf操作员的功能或某些标准方法，或者这甚至可能吗？

背景
该应用程序以从工作表调用的函数为中心，然后用于实例化类并使用SetTimer WinAPI函数调用方法。

您可能会说：“好吧，您可以只使用Application.OnTime”，如果没有从工作表中调用该函数，那么您是对的。有充分的理由，Excel的计算引擎明确忽略对Application.OnTime, 的调用（如果调用者是工作表）；但是，无论如何SetTimer都可以正常工作。

我想避免将公共函数放置在标准模块中的笨拙实现（这将取决于类的实例），我将能够在其中使用AddressOf运算符，尽管以一种丑陋的、未封装的方式。

编辑：正如评论中提到的，最初，我故意没有透露我正在尝试做什么以避免听到“你不应该那样做”，哈哈。我有一个工作类，它完全符合我的要求（即使用Ctrl+Shift+Enter的标准方法将数组返回到工作表），但我想尝试模拟当前正在测试的动态数组函数由Excel开发团队测试，不需要您选择范围并通过Ctrl+Shift+Enter 输入数组。我知道我是否问过类似“如何在没有Ctrl+Shift+Enter的情况下将数组从 UDF 返回到 WorkSheet”，每个人都会提供现有的答案和/或让我感到羞耻，（如果有人问我也会这样做，哈哈），因为问如何实现与Excel的计算引擎的预期运行方式相矛盾的东西。

话虽如此，我还有另一个版本的类，它使用QueryTable对象将数据放在工作表中，并且工作起来很像Dynamic Array Functions. 我可能会在Code Review上发布每个实现，看看我如何改进它们/获得一些见解，哪些将是最稳定的实现，等等。

Private Declare Function SetTimer Lib "user32" _
        (ByVal HWnd As Long, ByVal nIDEvent As Long, 
         ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Public Function Method1(varValsIn As Variant) As Variant
  
  Dim lngWindowsTimerID As Long
        
        'doing some stuff
        
        'call API function after doing some stuff
        lngWindowsTimerID = SetTimer(0&, 0&, 1, AddressOf DoStuff)

End Sub 

Private Sub DoStuff
    'Stuff to do
End Sub

标签： excelvbawinapi

解决方案

你可以使用一些汇编语言来打破vb的限制，当然，优劣取决于你。我只是个搬运工。有个函数Ge​​tClassProcAddress：</p> 

Private Function GetClassProcAddress(ByVal SinceCount As Long) As Long
    Dim i As Long, jmpAddress As Long

    CopyMemory i, ByVal ObjPtr(Me), 4                                ' get vtable
    CopyMemory i, ByVal i + (SinceCount - 1) * 4 + &H1C, 4           ' 
    CopyMemory jmpAddress, ByVal i + 1, 4                            ' The function address obtained is actually a table, a jump table
    GetClassProcAddress = i + jmpAddress + 5                         ' Calculate jump relative offset to get the actual address
End Function

参数SinceCount：来自类模块的顶层函数或属性，它是哪个函数？

  1. 当被搜索的函数是公共函数时，它的值是从顶部开始计算的函数个数，比如写在类模块顶部的公共函数WndProc，如果是第二个公共函数或属性则传1，然后依次传2……注意计算的时候还要计算public属性。

  2. 当被搜索的函数是局部函数时，即如果是Private修饰函数，则参数值为所有公共函数的个数+这个私有函数的索引。也是从顶部计算的，包括属性也是如此。

不幸的是，我想说我们不能直接使用它。一些参数会在编译后添加到函数中，例如 vTable 指针。所以我们需要构造一个小函数 -> 类函数。

Private Function GetClassProcAddr(obj As Object, ByVal Index As Long, _
    Optional ByVal ParamCount As Long = 4, Optional ByVal HasReturnValue As Boolean) As Long
    Static lReturn As Long, pReturn As Long
    Static AsmCode(50) As Byte
    Dim i As Long, pThis As Long, pVtbl As Long, pFunc As Long

    pThis = ObjPtr(obj)
    CopyMemory pVtbl, ByVal pThis, 4
    CopyMemory pFunc, ByVal pVtbl + (6 + Index) * 4, 4
    pReturn = VarPtr(lReturn)

    For i = 0 To UBound(AsmCode)                                'fill   nop
        AsmCode(i) = &H90
    Next
    AsmCode(0) = &H55                                           'push   ebp
    AsmCode(1) = &H8B: AsmCode(2) = &HEC                        'mov    ebp,esp
    AsmCode(3) = &H53                                           'push   ebx
    AsmCode(4) = &H56                                           'push   esi
    AsmCode(5) = &H57                                           'push   edi
    If HasReturnValue Then
        AsmCode(6) = &HB8                                       'mov    offset lReturn
        CopyMemory AsmCode(7), pReturn, 4
        AsmCode(11) = &H50                                      'push   eax
    End If
    For i = 0 To ParamCount - 1                                 'push   dword ptr[ebp+xx]
        AsmCode(12 + i * 3) = &HFF
        AsmCode(13 + i * 3) = &H75
        AsmCode(14 + i * 3) = (ParamCount - i) * 4 + 4
    Next
    i = i * 3 + 12
    AsmCode(i) = &HB9                                           'mov    ecx,this
    CopyMemory AsmCode(i + 1), pThis, 4
    AsmCode(i + 5) = &H51                                       'push   ecx
    AsmCode(i + 6) = &HE8                                       'call   relative address
    CopyMemory AsmCode(i + 7), pFunc - VarPtr(AsmCode(i + 6)) - 5, 4
    If HasReturnValue Then
        AsmCode(i + 11) = &HB8                                  'mov    eax,offset lReturn
        CopyMemory AsmCode(i + 12), pReturn, 4
        AsmCode(i + 16) = &H8B                                  'mov    eax,dword ptr[eax]
        AsmCode(i + 17) = &H0
    End If
    AsmCode(i + 18) = &H5F                                      'pop    edi
    AsmCode(i + 19) = &H5E                                      'pop    esi
    AsmCode(i + 20) = &H5B                                      'pop    ebx
    AsmCode(i + 21) = &H8B: AsmCode(i + 22) = &HE5              'mov    esp,ebp
    AsmCode(i + 23) = &H5D                                      'pop    ebp
    AsmCode(i + 24) = &HC3                                      'ret
    GetClassProcAddr = VarPtr(AsmCode(0))
End Function

代码参考来自：https ://blog.csdn.net/lyserver/article/details/4224676

推荐阅读