t-hom’s diary

主にVBAネタを扱っているブログ…とも言えなくなってきたこの頃。

VBA フォームデザイナーで作ったフォームを基にして、それと同じフォームを作り出すコードを自動生成するマクロ

VBA ユーザーフォーム

VBA関連のブログ記事を書いていて困るのが、フォーム関連である。
普通の標準モジュールなら、コピーして実行してもらうだけであるが、フォームを使うコードを紹介する際などは、フォームデザインとコントロール名や配置を書かなくてはならない。

たとえば、前回の記事では以下のように吹き出しでコントロール名を書いた。
f:id:t-hom:20160210234534p:plain

しかしこのように紹介したところで、どれだけの方がわざわざマクロを試してくれるだろうか。コードを張り付けて実行するだけなら簡単であるが、フォームを使うマクロではわざわざフォームを作成いただかないといけない。

エクスポートしてどこかにアップロードしておくという手もあるが、ダウンロードしてインポートするという一連の作業は割と面倒くさい。

そこで、もっと手軽にフォームを使ったマクロを実行いただくために、フォームを作る部分自体をコード化してしまえば良いのではないかと考えた。

これなら、マクロをコピーしてF5で実行していただくだけである。
ただ前提条件として、マクロのセキュリティ設定から「VBA プロジェクト オブジェクト モデルへのアクセスを信頼する」を有効にしていただく必要はあるが。


さて、いざフォームをコードでデザインしようと思うと、それはそれで面倒くさい。
コントロールの配置にもよるが、基本的にはフォームデザイナーで見たまま編集したほうがデザインしやすい。

ならば、デザイナーで作ったフォームを基にして、それと同じフォームを作り出すコードを自動生成できないかというのが今回の記事である。

とりあえず、フォームデザイナーで適当にフォームをデザインしてみた。
f:id:t-hom:20160213193626p:plain

フォーム名はMasterFormとしておく。
そして、標準モジュールに次のコードを貼りつけて実行する。

Sub フォームを作るコードを作るマクロ()
    Dim srcForm As UserForm
    Set srcForm = ThisWorkbook.VBProject _
        .VBComponents.Item("MasterForm").Designer

    Debug.Print "Sub CreateForm()"
    Debug.Print "    Dim f As UserForm"
    Debug.Print "    Set f = ThisWorkbook.VBProject.VBComponents.Add(3).Designer"

    Dim c As Control
    For Each c In srcForm.Controls
        Debug.Print "    With f.Controls.Add (""Forms." & TypeName(c) & ".1"")"
        Debug.Print "        .Name = """ & c.Name & """"
        Debug.Print "        .Width = " & c.Width
        Debug.Print "        .height = " & c.Height
        Debug.Print "        .Top = " & c.Top
        Debug.Print "        .Left = " & c.Left
        Debug.Print "        .TabIndex = " & c.TabIndex
        
        'コントロールによって無いかもしれないプロパティはエラースキップ
        On Error Resume Next
            Debug.Print "        .Caption = """ & c.Caption & """"
            Debug.Print "        .Text = """ & c.Text & """"
            Debug.Print "        .Font.Size = " & c.Font.Size
            Debug.Print "        .Font.Name = """ & c.Font.Name & """"
        On Error GoTo 0

        Debug.Print "    End With"
    Next
    Debug.Print "End Sub"
End Sub

すると、上記のコードはMasterFormのコントロールのプロパティを読み取って、自動で以下のコードを生成してイミディエイトウインドウに出力する。

Sub CreateForm()
    Dim f As UserForm
    Set f = ThisWorkbook.VBProject.VBComponents.Add(3).Designer
    With f.Controls.Add ("Forms.TextBox.1")
        .Name = "TextBox1"
        .Width = 132
        .height = 18
        .Top = 12
        .Left = 30
        .TabIndex = 0
        .Text = ""
        .Font.Size = 9
        .Font.Name = "MS UI Gothic"
    End With
    With f.Controls.Add ("Forms.TextBox.1")
        .Name = "TextBox2"
        .Width = 132
        .height = 18
        .Top = 36
        .Left = 30
        .TabIndex = 1
        .Text = ""
        .Font.Size = 9
        .Font.Name = "MS UI Gothic"
    End With
    With f.Controls.Add ("Forms.TextBox.1")
        .Name = "TextBox3"
        .Width = 132
        .height = 18
        .Top = 60
        .Left = 30
        .TabIndex = 2
        .Text = ""
        .Font.Size = 9
        .Font.Name = "MS UI Gothic"
    End With
    With f.Controls.Add ("Forms.TextBox.1")
        .Name = "TextBox4"
        .Width = 132
        .height = 18
        .Top = 84
        .Left = 30
        .TabIndex = 3
        .Text = ""
        .Font.Size = 9
        .Font.Name = "MS UI Gothic"
    End With
    With f.Controls.Add ("Forms.CommandButton.1")
        .Name = "CommandButton1"
        .Width = 60
        .height = 90
        .Top = 12
        .Left = 168
        .TabIndex = 4
        .Caption = "OK"
        .Font.Size = 9
        .Font.Name = "MS UI Gothic"
    End With
    With f.Controls.Add ("Forms.Label.1")
        .Name = "Label1"
        .Width = 12
        .height = 18
        .Top = 12
        .Left = 12
        .TabIndex = 5
        .Caption = "A"
        .Font.Size = 16.2
        .Font.Name = "MS UI Gothic"
    End With
    With f.Controls.Add ("Forms.Label.1")
        .Name = "Label2"
        .Width = 12
        .height = 18
        .Top = 36
        .Left = 12
        .TabIndex = 6
        .Caption = "B"
        .Font.Size = 16.2
        .Font.Name = "MS UI Gothic"
    End With
    With f.Controls.Add ("Forms.Label.1")
        .Name = "Label3"
        .Width = 12
        .height = 18
        .Top = 60
        .Left = 12
        .TabIndex = 7
        .Caption = "C"
        .Font.Size = 16.2
        .Font.Name = "MS UI Gothic"
    End With
    With f.Controls.Add ("Forms.Label.1")
        .Name = "Label4"
        .Width = 12
        .height = 18
        .Top = 84
        .Left = 12
        .TabIndex = 8
        .Caption = "D"
        .Font.Size = 16.2
        .Font.Name = "MS UI Gothic"
    End With
End Sub

あとはこのコードを張り付けて実行するだけで、同じフォームが作成される。
ただし、フォーム自体のサイズを変更する術は分からなかった。
※単純にWidthやHeightを設定すれば良いのかと思ったが、デザイン段階でコードでこれらの値を設定することはできないようだ。

また、この方法はリストボックスに対応していない。
MasterFormのリストボックスのTextプロパティはエラーにならずに読み取れる(空白)にもかかわらず、作成しようとするとTextプロパティへの設定がエラーになってしまう。

というわけでリストボックスに対応させるにはTypeNameにコントロールを渡して判定し、Textプロパティを設定しないように書き換える必要がある。今回は面倒なのでやめておいた。


前回の記事で紹介したライブラリを検索できる参照設定ダイアログのフォームを作成するコードは、
thom.hateblo.jp

こちら。

Sub CreateForm()
    Dim f As UserForm
    Set f = ThisWorkbook.VBProject.VBComponents.Add(3).Designer
    With f.Controls.Add("Forms.ListBox.1")
        .Name = "ListBox1"
        .Width = 571.85
        .Height = 154.55
        .Top = 48
        .Left = 6
        .ColumnCount = 2
        .TabIndex = 6
        .Font.Size = 9
        .Font.Name = "MS UI Gothic"
    End With
    With f.Controls.Add("Forms.TextBox.1")
        .Name = "TextBox1"
        .Width = 132
        .Height = 18
        .Top = 6
        .Left = 204
        .TabIndex = 1
        .Text = ""
        .Font.Size = 9
        .Font.Name = "MS UI Gothic"
    End With
    With f.Controls.Add("Forms.CommandButton.1")
        .Name = "cmd絞込み"
        .Width = 54
        .Height = 18
        .Top = 6
        .Left = 402
        .TabIndex = 3
        .Caption = "絞込み"
        .Font.Size = 9
        .Font.Name = "MS UI Gothic"
    End With
    With f.Controls.Add("Forms.CommandButton.1")
        .Name = "cmdクリア"
        .Width = 54
        .Height = 18
        .Top = 6
        .Left = 462
        .TabIndex = 4
        .Caption = "クリア"
        .Font.Size = 9
        .Font.Name = "MS UI Gothic"
    End With
    With f.Controls.Add("Forms.ListBox.1")
        .Name = "ListBox2"
        .Width = 571.25
        .Height = 87.95
        .Top = 229.2
        .Left = 6
        .ColumnCount = 2
        .TabIndex = 8
        .Font.Size = 9
        .Font.Name = "MS UI Gothic"
    End With
    With f.Controls.Add("Forms.CommandButton.1")
        .Name = "cmd検索"
        .Width = 54
        .Height = 18
        .Top = 6
        .Left = 342
        .TabIndex = 2
        .Caption = "検索"
        .Font.Size = 9
        .Font.Name = "MS UI Gothic"
    End With
    With f.Controls.Add("Forms.Label.1")
        .Name = "Label1"
        .Width = 132
        .Height = 12
        .Top = 36
        .Left = 6
        .TabIndex = 5
        .Caption = "ライブラリ一覧(ダブルクリックで選択)"
        .Font.Size = 9
        .Font.Name = "MS UI Gothic"
    End With
    With f.Controls.Add("Forms.Label.1")
        .Name = "Label2"
        .Width = 180
        .Height = 12
        .Top = 216
        .Left = 6
        .TabIndex = 7
        .Caption = "選択したライブラリ(ダブルクリックで解除)"
        .Font.Size = 9
        .Font.Name = "MS UI Gothic"
    End With
    With f.Controls.Add("Forms.CommandButton.1")
        .Name = "cmdOK"
        .Width = 78
        .Height = 18
        .Top = 324
        .Left = 498
        .TabIndex = 9
        .Caption = "OK"
        .Font.Size = 9
        .Font.Name = "MS UI Gothic"
    End With
    With f.Controls.Add("Forms.ComboBox.1")
        .Name = "ComboBox1"
        .Width = 168
        .Height = 18
        .Top = 6
        .Left = 30
        .TabIndex = 0
        .Text = ""
        .Font.Size = 9
        .Font.Name = "MS UI Gothic"
    End With
    With f.Controls.Add("Forms.Label.1")
        .Name = "Label3"
        .Width = 24
        .Height = 12
        .Top = 12
        .Left = 6
        .TabIndex = 10
        .Caption = "ブック"
        .Font.Size = 9
        .Font.Name = "MS UI Gothic"
    End With
    With f.Controls.Add("Forms.CommandButton.1")
        .Name = "cmd初期設定"
        .Width = 54
        .Height = 18
        .Top = 6
        .Left = 522
        .TabIndex = 11
        .Caption = "初期設定"
        .Font.Size = 9
        .Font.Name = "MS UI Gothic"
    End With
End Sub

※このコードは前述のマクロで出力したものにListBoxのTextプロパティ設定部分を削除し、ColumnCountの設定コードを手で付けくわえたものである。

前述したように、フォームサイズは設定できないので適当にデザイナで引き伸ばして欲しい。
また、フォーム自体のコードは前回記事にあるので要コピー。

当ブログは、amazon.co.jpを宣伝しリンクすることによってサイトが紹介料を獲得できる手段を提供することを目的に設定されたアフィリエイト宣伝プログラムである、 Amazonアソシエイト・プログラムの参加者です。