コードを使ったサンプル
引数も戻り値もない関数を実行する例
まずは、もっともシンプルにVBAの標準モジュール内に定義した引数を持たない関数のポインタで試してみます。VBAでは標準モジュール内で定義した関数に限って、AddressOf演算子でそのアドレスを取得することができます。
Public Sub NoParamNoReturn()
MsgBox "NoParamNoReturn is called."
End Sub
Public Sub Test1()
Dim lDispCallFuncResult As Long
'呼び出す関数の戻り値を受け取るVariant型変数を用意します。
'関数が戻り値を返さない場合でも、この変数は必要です。
Dim vFuncResult As Variant
'今回は変数宣言の直後なの初期化不要ですが、
'Variant型変数を使いまわす場合はこのようにEmptyを代入して
'初期化することができます。
vFuncResult = Empty
'VBAの関数のアドレスは、AddressOf演算子で取得します。
'列挙体の名前を入れてピリオドを入れた時点でVBAの入力支援機能が使えます。
'今回はSubプロシージャの呼び出しなので戻り値がないので
'vbEmpty(=0)を戻り値の型として指定します。
lDispCallFuncResult = DispCallFunc(0, AddressOf NoParamNoReturn, _
tagCALLCONV.CC_STDCALL, VbVarType.vbEmpty, _
0, 0, 0, VarPtr(vFuncResult))
'DispCallFunc APIの実行が成功すると、0が戻ります。
'ただし、これはDispCallFunc APIの実行の成功を意味するだけで
'目的の関数が成功したか否かとは別の話です。
Debug.Print lDispCallFuncResult
End Sub
引数と戻り値がある関数を実行する例
次も、まだVBAの標準モジュール内に定義した関数のポインタで試します。ただし、次は引数と戻り値があります。
Option Explicit
Private Declare Function DispCallFunc Lib "OleAut32.dll" _
(ByVal pvInstance As Long, _
ByVal oVft As Long, _
ByVal cc As Long, _
ByVal vtReturn As Integer, _
ByVal cActuals As Long, _
ByVal prgvt As Long, _
ByVal prgpvarg As Long, _
ByVal pvargResult As Long) As Long
Enum tagCALLCONV
CC_FASTCALL = 0
CC_CDECL = 1
CC_MSCPASCAL = CC_CDECL + 1
CC_PASCAL = CC_MSCPASCAL
CC_MACPASCAL = CC_PASCAL + 1
CC_STDCALL = CC_MACPASCAL + 1
CC_FPFASTCALL = CC_STDCALL + 1
CC_SYSCALL = CC_FPFASTCALL + 1
CC_MPWCDECL = CC_SYSCALL + 1
CC_MPWPASCAL = CC_MPWCDECL + 1
CC_MAX = CC_MPWPASCAL
End Enum
Public Function SixParamOneReturn( _
ByVal longVal As Long, ByRef longRef As Long, _
ByVal byteVal As Byte, ByRef byteRef As Byte, _
ByVal strVal As String, ByRef strRef As String _
) As Long
'ByVal...String は VC++でのBSTRに相当します。
'ByRef...String は VC++でのBSTR*に相当します。
Debug.Print "SixParamOneReturn"
Debug.Print "longVal = " & longVal
Debug.Print "longRef = " & longRef
Debug.Print "byteVal = " & byteVal
Debug.Print "byteRef = " & byteRef
Debug.Print "strVal = " & strVal
Debug.Print "strRef = " & strRef
Debug.Print
SixParamOneReturn = longVal + longRef
longVal = 100
longRef = 200
byteVal = 10
byteRef = 20
strVal = "strVal"
strRef = "strRef"
MsgBox "EightParamOneReturn is called."
End Function
Public Sub Test2()
'Test1で説明した注釈は省いてあります。
Dim lDispCallFuncResult As Long
Dim vFuncResult As Variant
vFuncResult = Empty
Dim lVal As Long, vlVal As Variant
Dim lRef As Long, vlRef As Variant
Dim bVal As Byte, vbVal As Variant
Dim bRef As Byte, vbRef As Variant
Dim sVal As String, vsVal As Variant
Dim sRef As String, vsRef As Variant
lVal = 12
lRef = 34
bVal = 56
bRef = 78
sVal = "string1"
sRef = "string2"
'DispCallFuncの仕様上
'呼び出したい関数に渡す引数はすべてVariant型で渡す必要がありますので
'すべての引数をVaraint型変数に代入しなおします。
'Variant型の配列を作って、配列に代入した方が楽ですが
'配列である必要がないことを示すために、あえて配列を作っていません。
'VBのByRefで指示される参照渡しは変数そのものを代入せず
'変数へのポインタを代入する必要があります。
vlVal = lVal 'ByVal引数なので値を代入
vlRef = VarPtr(lRef) 'ByRef引数なのでポインタを代入します。 C言語での&lRef に相当します。
vbVal = bVal
vbRef = VarPtr(bRef)
vsVal = sVal
vsRef = VarPtr(sRef)
'Variant型変数に代入したあとは
'それぞれのVariant変数の内部型をInteger型の配列に代入するとともに
'それぞれのVariant変数のアドレスをLong型の配列に代入します。
Dim iVarTypes(0 To 5) As Integer '見にくいですが最初のiは小文字のIです。
Dim lVarPtrs(0 To 5) As Long
iVarTypes(0) = VarType(vlVal) 'VbVarType.vbLongが代入されます。
lVarPtrs(0) = VarPtr(vlVal) 'C言語での&vlValに相当します。
iVarTypes(1) = VarType(vlRef) 'ポインタはLongなのでVbVarType.vbLongが代入されます。
lVarPtrs(1) = VarPtr(vlRef)
iVarTypes(2) = VarType(vbVal) 'VbVarType.vbByteが代入されます。
lVarPtrs(2) = VarPtr(vbVal)
iVarTypes(3) = VarType(vbRef) 'ポインタはLongなのでVbVarType.vbLongが代入されます。
lVarPtrs(3) = VarPtr(vbRef)
iVarTypes(4) = VarType(vsVal) 'VbVarType.vbStringが代入されます。
lVarPtrs(4) = VarPtr(vsVal)
iVarTypes(5) = VarType(vsRef) 'ポインタはLongなのでVbVarType.vbLongが代入されます。
lVarPtrs(5) = VarPtr(vsRef)
'今回はLong型が戻り値なので
'vbLong(=3)を戻り値の型として指定します。
'引数は6つあるので、第5引数には 6を指定します。
'第6引数には内部型を格納したInteger配列の先頭アドレスを指定します。
'第7引数には各Variant変数のアドレスを格納したLong配列の先頭アドレスを指定します。
lDispCallFuncResult = DispCallFunc(0, AddressOf SixParamOneReturn, _
tagCALLCONV.CC_STDCALL, VbVarType.vbLong, _
6, VarPtr(iVarTypes(0)), VarPtr(lVarPtrs(0)), VarPtr(vFuncResult))
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'なおこの部分はDispCallFunc の Declare文を次のようにした場合は
'第6,7,8引数のVarPtrは不要となります。
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Private Declare Function DispCallFunc Lib "OleAut32.dll" _
(ByVal pvInstance As Long, _
ByVal oVft As Long, _
ByVal cc As Long, _
ByVal vtReturn As Integer, _
ByVal cActuals As Long, _
ByRef prgvt As Integer, _
ByRef prgpvarg As Long, _
ByRef pvargResult As Variant) As Long
'第6,7,8引数について ByVal ... ポインタの型 から ByRef ... 変数の型 にします。
'第6引数を ByVal ... Long から ByRef ... Integer
'第7引数を ByVal ... Long から ByRef ... Long
'第8引数を ByVal ... Long から ByRef ... Variant
'これによりアドレス値を取得する処理はVBA側が裏で自動的にやってくれるので
'DispCallFunc呼び出し部分は次のようにすることができます。
'lDispCallFuncResult = DispCallFunc(0, AddressOf SixParamOneReturn, _
tagCALLCONV.CC_STDCALL, VbVarType.vbLong, _
6, iVarTypes(0), lVarPtrs(0), vFuncResult)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Debug.Print "Test2"
Debug.Print "lDispCallFuncResult = " & lDispCallFuncResult
Debug.Print "vFuncResult = " & vFuncResult
Debug.Print "lVal = " & lVal '元の値のままです。
Debug.Print "lRef = " & lRef 'ポインタを渡したので、元の値は呼び出し先での変更の影響を受けます。
Debug.Print "bVal = " & bVal
Debug.Print "bRef = " & bRef
Debug.Print "sVal = " & sVal
Debug.Print "sRef = " & sRef
End Sub
