職場のPCにOfficeしか入ってない皆様こんにちは！
Officeしか入ってなくてもVBAで開発を求められることはよくあると思います。
そこでまずはExcelのVBAでExcelをCOM経由で使うことを考えます。
目指すコード
今からやることをVBAの機能を使って書くとこんな感じです。
Excel.ApplicationというCLSIDをCreateObjectしてエクセルを別プロセスで立ち上げます。
Sub UseExcelByVBA()
Dim app As excel.Application
Set app = CreateObject("Excel.Application")
'エクセルを表示します
app.Visible = True
'... do something ...
'Dim wb As Workbook
'Set wb = app.Workbooks.Add()
'wb.Sheets(1).Range("A1") = "by VBA"
'Call wb.SaveAs(Filename:=PATH & "BookVBA.xlsx")
'Call wb.Close
'Set wb = Nothing
'app.Quit 'Optional auto exit
Set app = Nothing
End Sub
方法その1 VBAのOjbect型を活用
VBAのObject型はCOMのIUnknownインターフェイスを持ったオブジェクトです。
さらにメンバの名前や型が自動で出てくるものはIDispatch型であるといえます。
そこでExcel.ApplicationのIDispatchインターフェイスを取得しそれをObject型に代入します。
まずは下準備としてGUIDのUser Defined Typeを宣言します。
またWin32APIであるStringFromGUID2を使いGUID->文字列に変換するデバッグコードも宣言しておきます。
Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Declare Function StringFromGUID2 Lib "ole32" ( _
ByRef rguid As GUID, _
ByVal lpsz As Long, _
ByVal cchMax As Long) As Long
Sub DispGUID(objGuid As GUID)
Dim lRet As Long
Dim buf(100) As Byte
lRet = StringFromGUID2(objGuid, VarPtr(buf(0)), UBound(buf) - 1)
Debug.Print "lRet:" & lRet
Dim sTmp As String
sTmp = buf
Debug.Print Left$(sTmp, InStr(sTmp, vbNullChar) - 1)
End Sub
Excel.ApplicationのCLSIDおよびIDispatchインターフェイスのIIDを取得し、CoCreateInstanceした後にObject型の変数が生成したインスタンスを指すように無理やり書き換えます。
あとは普通のExcel.Application型としてキャストするなりして使えます。
Private Declare Function CLSIDFromString Lib "ole32" ( _
ByVal OleStringCLSID As Long, _
ByRef cGUID As GUID) As Long
Private Declare Function CoCreateInstance Lib "ole32" ( _
ByRef rclsid As GUID, _
ByVal pUnkOuter As Long, _
ByVal dwClsContext As Long, _
ByRef riid As GUID, _
ByRef ppv As Long) As Long
Private Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" _
(dest As Any, Source As Any, ByVal length&)
Const IID_IDISPATCH = "{00020400-0000-0000-C000-000000000046}"
Const CLSCTX_LOCAL_SERVER = &H4
'ポインターからオブジェクト型に変換します
Function ObjFromPtr(ByVal pObj As Long) As Object
Dim obj As Object
Call CopyMemory(obj, pObj, 4) 'objの先頭4byteをpObjに書き換えます
Set ObjFromPtr = obj '戻り値としてobjをセット (別の一時オブジェクトにコピーされます)
Call CopyMemory(obj, 0&, 4) '関数内で使用したobjの先頭4byteを0とします。
End Function
Sub UseExcelByComPart1()
Dim lRet As Long
Dim guidExcel As GUID
lRet = CLSIDFromString(StrPtr("Excel.Application"), guidExcel)
Debug.Print "lRet:" & lRet
Call DispGUID(guidExcel)
Dim iidDispatch As GUID
lRet = CLSIDFromString(StrPtr(IID_IDISPATCH), iidDispatch)
Debug.Print "lRet:" & lRet
Call DispGUID(iidDispatch)
'COMオブジェクトのIDispatchインターフェイスのインスタンスを作成
Dim lApp As Long
lRet = CoCreateInstance(guidExcel, 0, CLSCTX_LOCAL_SERVER, iidDispatch, lApp)
Debug.Print "lRet:" & lRet
'Object型の変数oAppが生成したインスタンスを指すようにする
Dim oApp As Object
Set oApp = ObjFromPtr(lApp)
'Object型として遅延バインディングで.visibleを使う
oApp.VISIBLE = True
'Object型からexcel.Application型へキャスト
Dim app As excel.Application
Set app = oApp
'あとはCreateObjectしたExcel.Application型と同等に使えます
Dim wb As Workbook
Set wb = app.Workbooks.Add
wb.Sheets(1).Range("A1") = "Instance by COM"
Set app = Nothing
Set oApp = Nothing
End Sub
方法その2 DispCallFuncを使う
IDispatchインターフェイスを持っていないCOMオブジェクトの場合はどうなるでしょうか？
Object型に代入しても遅延バインディングなどはできません。
そこでDispCallFuncというWin32API関数が用意されていますのでそれを使います。
ただしExcelはIDispatchインターフェイスを使ったOLEオートメーションを活用しており、DispCallFunc経由でIDispatchインターフェイスを使っていきます。
Private Declare Function DispCallFunc Lib "OleAut32" ( _
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
pvInstanceの指すインスタンスのインターフェイスのVTBLからoVft分のOffsetの関数を呼び出します。
何のことかはよくわかりませんが、CPPの仮想関数テーブルというものが関係しています。
簡単に言うとインターフェイスに何番目に宣言したかで関数を呼び出すということです。
IUnknownインターフェイスは関数を3つ持ちます。
それぞれの関数のオフセットは0,4,8と32bit分ずつ増えていきます。
MIDL_INTERFACE("00000000-0000-0000-C000-000000000046")
IUnknown
{
public:
virtual HRESULT STDMETHODCALLTYPE QueryInterface(
/* [in] */ REFIID riid,
/* [iid_is][out] */ __RPC__deref_out void __RPC_FAR *__RPC_FAR *ppvObject) = 0;
virtual ULONG STDMETHODCALLTYPE AddRef( void) = 0;
virtual ULONG STDMETHODCALLTYPE Release( void) = 0;
};
IDispatchインターフェイスはIUnknownを継承しています。
関数のオフセットは上のIDispatchの続きの12,16,20,24となっています。
MIDL_INTERFACE("00020400-0000-0000-C000-000000000046")
IDispatch : public IUnknown
{
public:
virtual HRESULT STDMETHODCALLTYPE GetTypeInfoCount(
/* [out] */ __RPC__out UINT *pctinfo) = 0;
virtual HRESULT STDMETHODCALLTYPE GetTypeInfo(
/* [in] */ UINT iTInfo,
/* [in] */ LCID lcid,
/* [out] */ __RPC__deref_out_opt ITypeInfo **ppTInfo) = 0;
virtual HRESULT STDMETHODCALLTYPE GetIDsOfNames(
/* [in] */ __RPC__in REFIID riid,
/* [size_is][in] */ __RPC__in_ecount_full(cNames) LPOLESTR *rgszNames,
/* [range][in] */ __RPC__in_range(0,16384) UINT cNames,
/* [in] */ LCID lcid,
/* [size_is][out] */ __RPC__out_ecount_full(cNames) DISPID *rgDispId) = 0;
virtual /* [local] */ HRESULT STDMETHODCALLTYPE Invoke(
/* [in] */ DISPID dispIdMember,
/* [in] */ REFIID riid,
/* [in] */ LCID lcid,
/* [in] */ WORD wFlags,
/* [out][in] */ DISPPARAMS *pDispParams,
/* [out] */ VARIANT *pVarResult,
/* [out] */ EXCEPINFO *pExcepInfo,
/* [out] */ UINT *puArgErr) = 0;
};
prgvtは引数の型でVARTYPEの配列です。VbLongなどの型とある程度互換性があります。
prgpvargは関数への引数でVARIANT型の配列であり、Variant型というのはVBAのコードと一部互換性がありそのまま使えます。
C言語で構造体の配列は、ポインタの配列と等価になりますので、Variant型へのポインタをLong型の配列に入れていきます。
pvargResultは関数の結果が入ります。引数としてはVARAIANT型へのポインタですがByRefなVariant型として指定することでVBAのVariant型がそのまま使えます。
さて、oApp.Visible = Trueを実行するにはどうすればいいのでしょうか？
まずIDispatch::GetIDsOfNames()で"Visible"の名前のDispIDを取得します。
そのDispIDをもとにIDispatch::Invoke()を呼び出します。
".Visible"はプロパティーであるため、IDispatch::Invoke()はプロパティーの設定をするように動作させます。
DispCallFunc経由でIDispatchインターフェイスのInvokeを呼び出します。
DispCallFuncもInvokeもオブジェクト内の関数を呼び出す機能であるため、多少見た目が複雑になります。
lRetはDispCallFunc自体の戻り値、vRetは呼び出した関数の戻り値、今回は使っていませんがIDispatch::Invokeで呼びだした関数の戻り値もあります。
COMオブジェクトは使った後はIUnknown::Release()を呼び出しますが、今回は呼び出すと起動したExcelが終了しますのでコメントアウトしています。
Const CC_STDCALL = &H4
Const DISPATCH_PROPERTYPUT = 4
Const DISPID_PROPERTYPUT = (-3)
Const LOCALE_SYSTEM_DEFAULT = &H800
Const IID_NULL = "{00000000-0000-0000-0000-000000000000}"
Sub UseExcelByComPart2()
Dim lRet As Long
Dim guidExcel As GUID
lRet = CLSIDFromString(StrPtr("Excel.Application"), guidExcel)
Debug.Print "lRet:" & lRet
Call DispGUID(guidExcel)
Dim iidDispatch As GUID
lRet = CLSIDFromString(StrPtr(IID_IDISPATCH), iidDispatch)
Debug.Print "lRet:" & lRet
Call DispGUID(iidDispatch)
'Create another excel instance
Dim lApp As Long
lRet = CoCreateInstance(guidExcel, 0, CLSCTX_LOCAL_SERVER, iidDispatch, lApp)
Debug.Print "lRet:" & lRet
'===ここまでPart1と同じ===
'Start following equation in genuine vba code.
'oApp.Visible = True
'Get DispID of "Visible" in Application.Excel
Dim vArgs(0 To 7) As Variant
Dim vt(0 To 7) As Integer
Dim pArgs(0 To 7) As Long
Dim vRet As Variant
Dim i As Integer
Dim iidNull As GUID
lRet = CLSIDFromString(StrPtr(IID_NULL), iidNull)
Debug.Print "lRet:" & lRet
Call DispGUID(iidNull)
Dim rgszNames(0) As Long
rgszNames(0) = StrPtr("Visible")
Dim lDispId As Long
vArgs(0) = VarPtr(iidNull)
vArgs(1) = VarPtr(rgszNames(0))
vArgs(2) = CLng(1)
vArgs(3) = CLng(LOCALE_SYSTEM_DEFAULT)
vArgs(4) = VarPtr(lDispId)
For i = 0 To 4
pArgs(i) = VarPtr(vArgs(i))
vt(i) = vbLong
Next i
'IDispatch::GetIDsOfNames()
lRet = DispCallFunc(lApp, 20, CC_STDCALL, vbLong, 5, vt(0), pArgs(0), vRet)
Debug.Print "lRet:" & lRet & " vRet:0x" & Hex(vRet)
Debug.Print "Visible DispID:" & lDispId
'oApp.Visible = TrueのTrueの部分
Dim propArg As Variant
propArg = True
Dim params As DISPPARAMS
Dim lDispIdPropPut As Long
lDispIdPropPut = DISPID_PROPERTYPUT
params.cArgs = 1
params.cNamedArgs = 1
params.rgdispidNamedArgs = VarPtr(lDispIdPropPut)
params.rgvarg = VarPtr(propArg)
Dim lArgErr As Long
vArgs(0) = lDispId
vArgs(1) = VarPtr(iidNull)
vArgs(2) = CLng(LOCALE_SYSTEM_DEFAULT)
vArgs(3) = CInt(DISPATCH_PROPERTYPUT)
vArgs(4) = VarPtr(params)
vArgs(5) = CLng(0)
vArgs(6) = CLng(0)
vArgs(7) = VarPtr(lArgErr)
For i = 0 To 7
pArgs(i) = VarPtr(vArgs(i))
vt(i) = vbLong
Next i
vt(3) = vbInteger
'IDispatch::Invoke()
' =oApp.VISIBLE = True
lRet = DispCallFunc(lApp, 24, CC_STDCALL, vbLong, 8, vt(0), pArgs(0), vRet)
Debug.Print "lRet:" & lRet & " vRet:0x" & Hex(vRet)
Debug.Print "lArgErr:0x" & Hex(lArgErr)
'IUnknown::Release()
'lRet = DispCallFunc(lApp, 8, CC_STDCALL, vbLong, 0, 0, 0, vRet)
'Debug.Print "lRet:" & lRet & " vRet:0x" & Hex(vRet)
End Sub
これでExcelの完全な操作が可能になるはずです。
app.Visible = Trueだけでこれだけのコード量、LOCを稼ぐにはよいのではないでしょうか？
VBAでCOMプログラミングをする土壌が整ったといえます。