VBAでExcelを使う

職場のPCにOfficeしか入ってない皆様こんにちは！
Officeしか入ってなくてもVBAで開発を求められることはよくあると思います。
そこでまずはExcelのVBAでExcelをCOM経由で使うことを考えます。

# 目指すコード
今からやることをVBAの機能を使って書くとこんな感じです。
`Excel.Application`というCLSIDをCreateObjectしてエクセルを別プロセスで立ち上げます。


```vbnet
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->文字列に変換するデバッグコードも宣言しておきます。

```vbnet
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型としてキャストするなりして使えます。

```vbnet
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](https://msdn.microsoft.com/ja-jp/library/windows/desktop/ms221473(v=vs.85).aspx)というWin32API関数が用意されていますのでそれを使います。
ただしExcelはIDispatchインターフェイスを使ったOLEオートメーションを活用しており、DispCallFunc経由でIDispatchインターフェイスを使っていきます。

```vbnet
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インターフェイス](https://msdn.microsoft.com/ja-jp/library/windows/desktop/ms680509(v=vs.85).aspx)は関数を3つ持ちます。
それぞれの関数のオフセットは0,4,8と32bit分ずつ増えていきます。

```cpp:Unknwn.h
        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インターフェイス](https://msdn.microsoft.com/ja-jp/library/windows/desktop/ms221608(v=vs.85).aspx)はIUnknownを継承しています。
関数のオフセットは上のIDispatchの続きの12,16,20,24となっています。

```OAIdl.h
    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が終了しますのでコメントアウトしています。

```vbnet
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プログラミングをする土壌が整ったといえます。