More than 3 years have passed since last update.

VBA 個人的汎用処理

Last updated at 2021-03-27Posted at 2018-11-13

特にホストに依存しない汎用処理群のメモ及びリンク。

未分類

変数へ代入

SetVar

'変数への代入処理簡略化用プロシージャ。
    '使用例:
        'SetVar(変数) = 任意の式
        'Property Let で定義することで普通の変数の代入に近い形式で記述が可能。
        'VBScript ではクラスの外でプロパティプロシージャを定義できないため注意。
'outVariable    :代入先の変数。
'inExpression   :代入したいユーザー定義型以外の任意の値。
Public Property Let SetVar( _
        ByRef outVariable As Variant, _
        ByRef inExpression As Variant _
    )
    
    If VBA.Information.IsObject(inExpression) Then
        'VarType では既定のプロパティの型を返すため、まずは IsObject で判定する。
        Set outVariable = inExpression
    ElseIf VBA.Information.VarType(inExpression) = VBA.VbVarType.vbDataObject Then
        '特定のオブジェクト(<> Object)では IsObject が False になるので追加で判定する。
        Set outVariable = inExpression
            'VBA.VbVarType.vbDataObject = 13 = VT_UNKNOWN : An object implementing the IUnknown interface.
            'https://docs.microsoft.com/ja-jp/dotnet/api/microsoft.visualstudio.package.variant.varianttype?view=visualstudiosdk-2019
    Else
        '値型だった場合。
        Let outVariable = inExpression
    End If
End Property

VBAは変数への代入時に値型・参照型でLet・Setを使い分ける必要があるため、そこを隠蔽するためのもの。

よく見るのはIsObjectのみの判定だが、それだと一部漏れが出るため、VarTypeも併用している。
VarTypeだけでは既定のメンバーを持っている場合に意図しない動作をする（既定のメンバーの型が出力される）ため両方を併用する必要がある。

Propertyを使っているのは個人的好み。

使用例

'for Excel
Const RangeType = 8
Dim buf As Variant
SetVar(buf) = _
    Application.InputBox("セルを選択", Type:=RangeType)

If VBA.IsObject(buf) Then
    'Select
Else
    'Cancel
End If

小ネタ

以下の内容は、通常は知らなくても問題ないニッチな内容です。

`vbDataObject`の考慮が必要な理由

VBAで変数への代入にSetが必要な値を「オブジェクト」と定義したとき、VBAの変数宣言に使用できるObjectと「オブジェクト」は異なるものになります。

「オブジェクト」の方がより広い範囲を示し、「オブジェクト」の中にObjectが含まれます。

COM関連の用語で表現すると「オブジェクト」はIUnknownインターフェイスの事であり、参照カウントや具象型の変換を担当するものとなります。
ObjectはIDispatchインターフェイスのことで、遅延バインディング(入力補完が出ない状態でも名前が合っていれば処理を呼び出せるもの)を担当するものになります。

VarTyoe関数の返値のvbObjectの値は9、vbDataObjectの値は13となっていますが、Variant.VariantType Enum | Microsoft Docsなどを見ると、以下のように定義されてます。

|識別子|値|説明|
|:--|:--:|:--|
|VT_DISPATCH|9|An object that implements the IDispatch interface.|
|VT_UNKNOWN|13|An object implementing the IUnknown interface.|

また、VBAの任意のオブジェクトモジュールでIUnknownのメンバーであるQueryInterface・AddRef・Release、IDispatchのメンバーであるInvokeなどを定義しようとすると、以下のコンパイルエラーが発生します。

実際に`vbDataObject`の判定が行われるサンプル。

vbDataObject

Sub SampleOfSetVarvbDataObject()
    'VarType が vbDataObject を返す例。
    
    Dim c As VBA.Collection
    Set c = New VBA.Collection
    
    Dim ev As stdole.IEnumVARIANT
    SetVar(ev) = c.[_NewEnum]()
    
    Dim dic As Object 'As Scripting.Dictionary
    Set dic = CreateObject("Scripting.Dictionary")
    SetVar(ev) = CallByName(dic, "_NewEnum", VbMethod)
    
    '以下のコードの実行には、参照設定「UIAutomationClient」が必須。
    Dim cui As UIAutomationClient.CUIAutomation
    SetVar(cui) = New UIAutomationClient.CUIAutomation
    
End Sub

`Let`の動作

上部では

VBAは変数への代入時に値型・参照型でLet・Setを使い分ける必要がある

と書きましたが、この表現はやや語弊があり「オブジェクトをLetで変数に代入しようとすると既定のメンバーが呼び出され、その評価結果が値かオブジェクトに関わらず変数に代入される」という動作もしたりします。

例えばユーザーフォームを変数にSet無しで代入すると、ユーザーフォームの既定のメンバーであるControlsオブジェクトが変数に代入されます。

コレクション内要素取得

TryGet

'require SetVar
Public Function TryGet( _
            Index As Variant, _
            Collection As Object, _
            Optional ByRef outItem As Variant _
        ) As Boolean
    
    On Error Resume Next
        SetVar(outItem) = Collection.Item(Index)
        Let TryGet = (Err.Number = 0)
    On Error GoTo 0
    
End Function

Itemというメンバーを持っているコレクションに対して、Indexの要素を取得してみる処理。

Itemはプロパティ・メソッド両方あり得るため、CallByNameではなく、遅延バインディングでVBAさんにいい感じに処理してもらっている。

見つかれば返り値がTrueで、参照渡しのoutItemに見つかった要素が入る。

存在しない要素にアクセスしたときにエラーが出ることを前提としているため、Scripting.Dictionaryなどには使えない点に注意。

使用例

'for Excel
'"Sheet1"が存在すれば位置と名前を表示
Dim ws1 As Excel.Worksheet
If TryGet("sheet1", ThisWorkbook.Worksheets, ws1) Then
    Debug.Print ws1.Index, ws1.Name
End If

'第3引数はOptionalなので存在判定のみも可
Dim sheet2Exists As Boolean
sheet2Exists = TryGet("Sheet2", ThisWorkbook.Worksheets)

配列関係

次元取得

DimensionsOf

'配列の次元数を取得する。初期化していない動的配列の場合は0
Public Function DimensionsOf(anyArray As Variant) As Long
    If Not VBA.IsArray(anyArray) Then Err().Raise 13
    
    'VBAの多次元配列の次元の上限
    Const MAX_ARRAY_DIMENSION = 60

    Dim d As Long, no_mean_var As Long
    On Error Resume Next
        For d = 1 To MAX_ARRAY_DIMENSION
            no_mean_var = LBound(anyArray, d)
            If Err.Number <> 0 Then Exit For
        Next d
    On Error GoTo 0

    'VBAのFor文は完走すると指定した数値+1になる
    Let DimensionsOf = (d - 1) '0 To 60
    
End Function

VBAそのものには配列の次元数を取得する方法が用意されていないため、無理矢理取得するための処理。

ReDim ステートメント | Microsoft Docs 内に以下の記述があるため、ループの最大回数としている。

subscripts 必ず指定します。配列変数のディメンションです。最大 60 の複数ディメンションを宣言できます。

JScriptのVBArrayオブジェクトは次元を取得できるのに、素のVBAでは取得できないのは本当になぜなのか……。

使用例

       '1  2  3  4  5  6  7  8  9 10
Dim arrayOf60Dim( _
        1, 0, 0, 0, 0, 0, 0, 0, 0, 0, _
        2, 0, 0, 0, 0, 0, 0, 0, 0, 0, _
        3, 0, 0, 0, 0, 0, 0, 0, 0, 0, _
        4, 0, 0, 0, 0, 0, 0, 0, 0, 0, _
        5, 0, 0, 0, 0, 0, 0, 0, 0, 0, _
        6, 0, 0, 0, 0, 0, 0, 0, 0, 0)

Debug.Print DimensionsOf(arrayOf60Dim) '->60
Dim b() As Variant
Debug.Print DimensionsOf(b) '->0

要素数取得

SizeOfArray

Public Function SizeOfArray( _
        anyArray As Variant, _
        Optional dimension As Long = 1 _
    ) As Long
    Let SizeOfArray = UBound(anyArray, dimension) - LBound(anyArray, dimension) + 1
End Function

配列の任意の次元の要素数を取得する。

UBound・LBoundはVBEだと補完が効かないため、入力を簡略化するためのもの。

その他リンク

自分の記事

You get articles that match your needs
You can efficiently read back useful information
You can use dark theme

What you can do with signing up

VBA 個人的汎用処理

未分類

変数へ代入

小ネタ

vbDataObjectの考慮が必要な理由

実際にvbDataObjectの判定が行われるサンプル。

Letの動作

コレクション内要素取得

配列関係

次元取得

要素数取得

その他リンク

自分の記事

汎用

Office共通

Excel

Win32API

Outlook

その他

`vbDataObject`の考慮が必要な理由

実際に`vbDataObject`の判定が行われるサンプル。

`Let`の動作