AdressOf pour A97

AdressOf retrourne le pointeur d'une variable

Apparue avec Access 2000, il faut utiliser la fonction ci-dessous en cas d'utilisation de Access 97

Option Compare Database
Option Explicit
'/
'/ A placer dans la partie déclarative
'/
'
'/ AdrOF [ pour ACC97 - utilise vba332.dll ]
'
Private Declare Function GetCurrentVbaProject Lib "vba332.dll" _
                     Alias "EbGetExecutingProj" (hProject As Long) As Long
Private Declare Function GetFuncID Lib "vba332.dll" _
                     Alias "TipGetFunctionId" _
                    (ByVal hProject As Long, ByVal strFunctionName As String, _
                    ByRef strFunctionId As String) As Long
Private Declare Function GetAddr Lib "vba332.dll" _
                    Alias "TipGetLpfnOfFunctionId" _
                   (ByVal hProject As Long, ByVal strFunctionId As String, _
                    ByRef lpfn As Long) As Long

La fonction :

Private Function AddrOf(strFuncName As String) As Long
    ' Function AddrOf
    '
    ' Parameters: strFuncName : String with the Name of Function
    ' Description: Returns a function pointer of a VBA private function given its name. This function
    ' gives similar functionality to VBA as VB5 has with the AddressOf param type.
    '
    ' NOTE: This function only seems to work if the proc you are trying to get a pointer
    ' to is in the current project. This makes sense, since we are using a function
    ' named EbGetExecutingProj.
    Dim hProject As Long
    Dim lngResult As Long
    Dim strID As String
    Dim lpfn As Long
    Dim strFuncNameUnicode As String
    Const NO_ERROR = 0

    ' The function name must be in Unicode, so convert it.
    strFuncNameUnicode = StrConv(strFuncName, vbUnicode)
    ' Get the current VBA project
    ' The results of GetCurrentVBAProject seemed inconsistent, in our tests,
    ' so now we just check the project handle when the function returns.
    Call GetCurrentVbaProject(hProject)
    ' Make sure we got a project handle... we always should, but you never know!
    If hProject <> 0 Then
        ' Get the VBA function ID (whatever that is!)
        lngResult = GetFuncID(hProject, strFuncNameUnicode, strID)
        ' We have to check this because we GPF if we try to get a function pointer
        ' of a non-existent function.
        If lngResult = NO_ERROR Then
            ' Get the function pointer.
            lngResult = GetAddr(hProject, strID, lpfn)
            If lngResult = NO_ERROR Then
                AddrOf = lpfn
            End If
        End If
    End If
End Function