よく使うCreateObject

Excel VBA 作ってみた

前回は、ヘッダー行からEnumを作成する際によく使用するパターンを、
既定値としてワンクリックで設定できるようにしてみた。
infoment.hatenablog.com

今日も、前回の続きから。
f:id:Infoment:20201111224710p:plain

先日から、変数宣言の文字列を作成するためのユーザーフォームを
作成している。そこで、ついでにいつも使用するCreateObjectも
ワンクリックで作成できれば、便利になるのではないかと考えた。

ということで、MultiPateにページを追加した。オブジェクト名は、
pgCreateObjectとしてある。都合が悪くなったら、変更するかも
しれない。

このページ上に、こんな風にコンボボックスなどを配置してみた。
f:id:Infoment:20201111225408p:plain

  1. オブジェクト名を選択するコンボボックス：ObjectNameComboBox
  2. 変数名を入力するためのテキストボックス：VariableNameTextBox
  3. アーリーバインディング用オプションボタン：EarlyBindingOptionButton
  4. レイトバインディング用オプションボタン：LateBindingOptionButton

アーリーバインディングおよびレイトバインディングに関しては、
Web上で多くの方が詳しく解説されているため、説明については
先達に委ねることにする。

ユーザーフォーム

さて、今回採った手法について予め言い訳しておくと、色々と検討する内に
かなりくどくなってしまった。きちんと考えれば、もっとスマートになるに
違いない。

まずオブジェクト名は、個人的によく使用する以下の三つから選ぶことにした。

  1. ファイルシステムオブジェクト
  2. 連想配列（辞書）
  3. 正規表現

個人の好みなので、流用される際の増減は自由だ。

コンボボックスのリスト設定用配列がこちら。

Private Property Get ObjectNameArray() As Variant
    ObjectNameArray = Array("ファイルシステムオブジェクト", _
                            "連想配列（辞書）", _
                            "正規表現")
End Property

ユーザーフォーム初期化時に、セットしてあげよう。
ついでに初期値として、アーリーバインディング書式を選択しておく。

Private Sub UserForm_Initialize()

    ' 選択範囲が１列の場合、このツールを使用する条件不成立とする。
    If UBound(HeaderList) = -1 Then Exit Sub
    
    ' 選択範囲のヘッダー部をリスト表示。
    ItemListBox.List = HeaderList
    
    ' 宣言変更用コンボボックス。
    DeclarationComboBox.List = DeclarationArray

    ' 変数の型変更用コンボボックス。
    TypeComboBox.List = TypeArray

    ' CreateObject選択用コンボボックス。
    ObjectNameComboBox.List = ObjectNameArray   ' <--- 今回追加
    
    ' CreateObjectの書式選択初期値。
    OB_EarlyBinding.Value = True   ' <--- 今回追加
    
    ' 文字修正ボタンを無効化。
    ' ※現時点でListBox未選択のため。
    RenameButton.Enabled = False
    
    ' クリップボードへのコピーボタン無効化
    ' ※リストボックスが４列の場合に特化しているため。
    ' 　（ユーザーフォーム起動時は複数行１列）。
    CopyButton.Enabled = False
    
    ' Enum作成ボタンを無効化。
    ' ※現時点でEnum名称など未記入のため。
    EnumButton.Enabled = False
    
End Sub

コンボボックスで選ばれた内容に対し、よく使う変数名を追従セットさせる
ことで、少しでも手間を減らしたい。
↓ 下ごしらえ。

' CreateObject用辞書に用いるID。
Enum CreateObjectID
    idFileSystemObject
    idDictionary
    idRegExp
    [_eLast]
End Enum

' CreateObjcet変数名辞書
Private Property Get CreateObjectVariableName() As Object
    Dim Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")
        
        Dict(CreateObjectID.idFileSystemObject) = "FSO"
        Dict(CreateObjectID.idDictionary) = "Dict"
        Dict(CreateObjectID.idRegExp) = "myReg"
        
    Set CreateObjectVariableName = Dict
End Property

Private Property Get ObjectID() As Long
    Select Case ObjectNameComboBox
        Case "ファイルシステムオブジェクト"
            ObjectID = CreateObjectID.idFileSystemObject
        
        Case "連想配列（辞書）"
            ObjectID = CreateObjectID.idDictionary
        
        Case "正規表現"
            ObjectID = CreateObjectID.idRegExp
    End Select
End Property

これにより、以下の手順で変数名をセットできるようになった。
※セットののち、任意の変数名に上書き可能。

  1. コンボボックスでCreateObject選択
  2. 選択結果に対応するIDを取得
  3. 同IDに紐づく変数名を辞書から取得
  4. 取得した変数名をテキストボックスにセット
Private Sub ObjectNameComboBox_Change()
    VariableNameTextBox = CreateObjectVariableName(ObjectID)
    CopyButton.Enabled = True
End Sub

これで、宣言用文字列に必要な三つの条件がそろった。

  1. アーリーバインディング／レイトバインディング
  2. 変数名
  3. CreateObjectの種類

ここから、これらを組み合わせて文字列を作成するための配列を作成する。
今回は個人的にほとんど使用したことがない、三次元配列で作成してみた。
良かれと思って作った結果、かなり大げさなものになってしまった。

' バインディング書式。
Enum BindingType
    btEarlyBinding
    btLateBinding
    [_eLast]
End Enum

' CreateObjectセット用項目名。
Enum CreateObjectItemName
    ' 参照設定名などのコメント。
    incomment
    ' 宣言ステートメント。
    inDeclarate
    ' 初期化またはCreateObject
    inInitialize
    [_eLast]
End Enum

' CreateObject用配列
Private Property Get CreateObjectArray() As Variant
    Dim arr() As Variant
    ReDim arr(BindingType.[_eLast] - 1, _
              CreateObjectID.[_eLast] - 1, _
              CreateObjectItemName.[_eLast] - 1)

        ' ファイルシステムオブジェクト。
        arr(btEarlyBinding, idFileSystemObject, incomment) = _
            "' 参照設定：Microsoft Scripting Runtime"
        arr(btEarlyBinding, idFileSystemObject, inDeclarate) = _
            "Dim " & CreateObjectVariableName(idFileSystemObject) & " As Scripting.FileSystemObject"
        arr(btEarlyBinding, idFileSystemObject, inInitialize) = _
            "Set " & CreateObjectVariableName(idFileSystemObject) & "=New Scripting.FileSystemObject"

        arr(btLateBinding, idFileSystemObject, incomment) = vbNullString
        arr(btLateBinding, idFileSystemObject, inDeclarate) = _
            "Dim " & CreateObjectVariableName(idFileSystemObject) & " As Object"
        arr(btLateBinding, idFileSystemObject, inInitialize) = _
            "Set " & CreateObjectVariableName(idFileSystemObject) & "=CreateObject(""Scripting.FileSystemObject"")"

        ' 連想配列（辞書）。
        arr(btEarlyBinding, idDictionary, incomment) = _
            "' 参照設定：Microsoft Scripting Runtime"
        arr(btEarlyBinding, idDictionary, inDeclarate) = _
            "Dim " & CreateObjectVariableName(idDictionary) & " As Scripting.Dictionary"
        arr(btEarlyBinding, idDictionary, inInitialize) = _
            "Set " & CreateObjectVariableName(idDictionary) & "=New Scripting.Dictionary"

        arr(btLateBinding, idDictionary, incomment) = vbNullString
        arr(btLateBinding, idDictionary, inDeclarate) = _
            "Dim " & CreateObjectVariableName(idDictionary) & " As Object"
        arr(btLateBinding, idDictionary, inInitialize) = _
            "Set " & CreateObjectVariableName(idDictionary) & "=CreateObject(""Scripting.Dictionary"")"
            
        ' 正規表現。
        arr(btEarlyBinding, idRegExp, incomment) = _
            "' 参照設定：Microsoft VBScript Regular Expressions 5.5"
        arr(btEarlyBinding, idRegExp, inDeclarate) = _
            "Dim " & CreateObjectVariableName(idRegExp) & " As VBScript_RegExp_55.RegExp"
        arr(btEarlyBinding, idRegExp, inInitialize) = _
            "Set " & CreateObjectVariableName(idRegExp) & "=New VBScript_RegExp_55.RegExp"

        arr(btLateBinding, idRegExp, incomment) = vbNullString
        arr(btLateBinding, idRegExp, inDeclarate) = _
            "Dim " & CreateObjectVariableName(idRegExp) & " As Object"
        arr(btLateBinding, idRegExp, inInitialize) = _
            "Set " & CreateObjectVariableName(idRegExp) & "=CreateObject(""VBScript.RegExp"")"
            
        CreateObjectArray = arr

End Property

今回は、リストボックスの中身を一切使用しない。
従って、「クリップボードへコピー」ボタンの内容を、pgCreateObjectの場合と
それ以外の場合で分岐させる必要が出てきた。

Private Property Get CopyText() As String
    Dim SourceArray As Variant
        SourceArray = ItemListBox.List
    Dim arr() As Variant
    Dim temp As Variant
    Dim myDelimiter As String
        If MultiPage.SelectedItem.Name = "pg変数" Then
            myDelimiter = " "
        End If
    Dim i As Long
    
        Select Case MultiPage.SelectedItem.Name
        
            Case "pg変数", "pgEnum"
            
                ReDim arr(ItemListBox.ListCount - 1)
                For i = 0 To ItemListBox.ListCount - 1
                    ' index関数による配列のスライスは、配列のindexではなく
                    ' 「ｉ番目」の切り出しであることに注意。
                    ' （０行目を指定すると配列の全てが返ってくる）。
                    temp = WorksheetFunction.Index(SourceArray, i + 1, 0)
                    ' 空白行があっても半角スペースで結合してしまうが、
                    ' VBEに貼り付けた時点で消してくれる。
                    ' なお、Enumの場合は半角を挟まず、そのまま結合する。
                    ' ※字下げなどレイアウトの都合による。
                    arr(i) = Join(temp, myDelimiter)
                Next
            
            Case "pgCreateObject"
                ReDim arr(CreateObjectItemName.[_eLast] - 1)
                    arr(incomment) = CreateObjectArray(TypeID, ObjectID, incomment)
                    arr(inDeclarate) = CreateObjectArray(TypeID, ObjectID, inDeclarate)
                    arr(inInitialize) = CreateObjectArray(TypeID, ObjectID, inInitialize)
        
        End Select
                
        CopyText = Join(arr, vbNewLine)
End Property
結果確認

それでは、実際に動作させてみよう。
今回は、以下の２点を確認してみる。

  1. アーリーバインディング書式で連想配列作成。
  2. レイトバインディング書式で正規表現を作成。

上記の結果がこちら。
注）参照設定は別途、手作業による操作が必要。
f:id:Infoment:20201111232737g:plain

今回も、想定した内容を実現することが出来た。

次回は、本シリーズのまとめです。

参考まで。