まずはじめにやりたいこと。
VBAを組み、呼び出しやマクロの起動に使うボタンを毎回用意するのは大変な作業の一つです。
そこで自動生成用のコードを作り置きしておけば、呼び出しすることで毎回用意することが不要になる。
VBAの仕様として、VBAからでもボタンを生成する際に、
SubプロシージャやFunctionプロシージャを埋め込むことができます。
今回は、Subを実行できるように書きましたが、Subの組み込む際に、
Functionに切り替えれば、簡単に変更が可能です。
では、さっそくコードに移ります。
ソース説明
初期化処理
- Private BUTTON_INFO As Variant: ボタンの情報を格納する変数。ボタンの名前、表示名、クリック時の処理を保持します。
- Private Sub InitializeButtons(): BUTTON_INFOを初期化し、ボタンの情報(名前、表示名、クリックイベントのハンドラー)を設定します。
' GUICreateModule
Private BUTTON_INFO As Variant
Private Sub InitializeButtons()
' ボタン情報を設定
BUTTON_INFO = Array( _
Array("btnInitialize", "イニシャライズ", "HandleButtonClick"), _
Array("btnImportData", "インポート", "HandleButtonClick"), _
Array("btnReflectData", "リファクト", "HandleButtonClick") _
)
End Sub
Sub AddButton()
InitializeButtons
' ボタンを配置
AddButtonsFromTemplate ActiveSheet.Name, 10, 2, "X", BUTTON_INFO
ActiveSheet.Cells(1, 1).Select
End Sub
ボタンの生成
-
Sub AddButton(): ボタンを追加するためのサブルーチンです。まずボタン情報を初期化し、その後
AddButtonsFromTemplate
メソッドを呼び出してボタンを配置します。処理終了後、シートの最初のセル(A1セル)を選択します。
Sub AddButtonsFromTemplate(TargetSheetName As String, setRow As Double, setColumn As Double, flag As String, buttonInfo As Variant, Optional ByVal TemplateSheetName As String = "Template")
' シートを設定
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(TargetSheetName)
Dim templateSheet As Worksheet: Set templateSheet = ThisWorkbook.Sheets(TemplateSheetName)
' テンプレートからボタンをコピー
Dim templateShape As Shape: Set templateShape = templateSheet.Shapes("ShapeBTN") ' テンプレートのShape名を指定
' 既存のボタンを削除
Dim shp As Shape
For Each shp In ws.Shapes
If shp.Type = msoAutoShape Then shp.Delete
Next shp
Dim topPos As Double: topPos = ws.Cells(setRow, setColumn).Top
Dim leftPos As Double: leftPos = ws.Cells(setRow, setColumn).Left
Dim margin As Double: margin = 20
' ボタンのプロパティを設定
Dim i As Long
For i = LBound(buttonInfo) To UBound(buttonInfo)
Dim btn As Shape
' 複製したボタンをメインシートに貼り付け
templateShape.Copy
ws.Paste
Set btn = ws.Shapes(ws.Shapes.Count)
With btn
.Name = buttonInfo(i)(0)
.TextFrame.Characters.Text = buttonInfo(i)(1)
.OnAction = buttonInfo(i)(2)
.Top = topPos
.Left = leftPos
' 次のボタンの位置を調整
If flag = "X" Then
leftPos = leftPos + btn.Width + margin
ElseIf flag = "Y" Then
topPos = topPos + btn.Height + margin
End If
End With
Next i
End Sub
-
Sub AddButtonsFromTemplate(...): 指定されたシートにボタンを配置するサブルーチンです。テンプレートシートからボタンの形状をコピーし、配置するシートに貼り付け、ボタンの名前、表示テキスト、クリックイベントのハンドラーを設定します。ボタンの配置位置は
flag
によって決定され、"X" なら横方向、"Y" なら縦方向に配置されます。
' 各ボタンのClickイベントを処理するハンドラー
Public Function HandleButtonClick()
' BUTTON_INFOが初期化されていない場合は初期化する
If IsEmpty(BUTTON_INFO) Then InitializeButtons
Dim btnName As String: btnName = Application.Caller
Dim i As Long
For i = LBound(BUTTON_INFO) To UBound(BUTTON_INFO)
If btnName = BUTTON_INFO(i)(0) Then
Application.StatusBar = BUTTON_INFO(i)(1) & "がクリックされました。"
Exit Function
End If
Next i
Application.StatusBar = "不明なボタンがクリックされました。"
End Function
-
Public Function HandleButtonClick(): ボタンがクリックされたときに呼び出される関数です。最初に
BUTTON_INFO
が初期化されていない場合は初期化します。次にクリックされたボタンの名前を取得し、それに対応するメッセージをステータスバーに表示します。ボタンの名前がBUTTON_INFO
に含まれていない場合は、不明なボタンがクリックされた旨のメッセージを表示します。
ソースコード全体
GUICreateModule
' GUICreateModule
Private BUTTON_INFO As Variant
Private Sub InitializeButtons()
' ボタン情報を設定
BUTTON_INFO = Array( _
Array("btnInitialize", "イニシャライズ", "HandleButtonClick"), _
Array("btnImportData", "インポート", "HandleButtonClick"), _
Array("btnReflectData", "リファクト", "HandleButtonClick") _
)
End Sub
Public Sub AddButton()
InitializeButtons
' ボタンを配置
AddButtonsFromTemplate ActiveSheet.Name, 2, 3, "X", BUTTON_INFO
ActiveSheet.Cells(1, 1).Select
End Sub
Sub AddButtonsFromTemplate(TargetSheetName As String, setRow As Double, setColumn As Double, flag As String, buttonInfo As Variant, Optional ByVal ShapeButtonName As String = "ShapeBTN", Optional ByVal TemplateSheetName As String = "Template")
' シートを設定
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(TargetSheetName)
Dim templateSheet As Worksheet: Set templateSheet = ThisWorkbook.Sheets(TemplateSheetName)
' テンプレートからボタンをコピー
Dim templateShape As Shape: Set templateShape = templateSheet.Shapes(ShapeButtonName) ' テンプレートのShape名を指定
' 既存のボタンを削除
Dim shp As Shape
For Each shp In ws.Shapes
If shp.Type = msoAutoShape Then shp.Delete
Next shp
Dim topPos As Double: topPos = ws.Cells(setRow, setColumn).Top
Dim leftPos As Double: leftPos = ws.Cells(setRow, setColumn).Left
Dim margin As Double: margin = 20
' ボタンのプロパティを設定
Dim i As Long
For i = LBound(buttonInfo) To UBound(buttonInfo)
Dim btn As Shape
' 複製したボタンをメインシートに貼り付け
templateShape.Copy
ws.Paste
Set btn = ws.Shapes(ws.Shapes.Count)
With btn
.Name = buttonInfo(i)(0)
.TextFrame.characters.Text = buttonInfo(i)(1)
.OnAction = buttonInfo(i)(2)
.Top = topPos
.Left = leftPos
' 次のボタンの位置を調整
If flag = "X" Then
leftPos = leftPos + btn.width + margin
ElseIf flag = "Y" Then
topPos = topPos + btn.height + margin
End If
End With
Next i
End Sub
' 各ボタンのClickイベントを処理するハンドラー
Public Function HandleButtonClick()
' BUTTON_INFOが初期化されていない場合は初期化する
If IsEmpty(BUTTON_INFO) Then InitializeButtons
Dim btnName As String: btnName = Application.Caller
Dim i As Long
For i = LBound(BUTTON_INFO) To UBound(BUTTON_INFO)
If btnName = BUTTON_INFO(i)(0) Then
Application.StatusBar = BUTTON_INFO(i)(1) & "がクリックされました。"
Exit Function
End If
Next i
Application.StatusBar = "不明なボタンがクリックされました。"
End Function
Main[Sheets]
Private BUTTON_INFO As Variant
Private Sub InitializeButtons()
Dim ShapeActionName As String
ShapeActionName = ActiveSheet.CodeName & ".ShapeAction"
' ボタン情報を設定
BUTTON_INFO = Array( _
Array("btnInitialize", "横向きに配置", ShapeActionName), _
Array("btnImportData", "縦向きに配置", ShapeActionName), _
Array("btnReflectData", "リセット", ShapeActionName) _
)
End Sub
Sub AddButton()
InitializeButtons
' ボタンを配置
AddButtonsFromTemplate ActiveSheet.Name, 10, 2, "X", BUTTON_INFO
ActiveSheet.Cells(1, 1).Select
End Sub
Public Sub ShapeAction()
' BUTTON_INFOが初期化されていない場合は初期化する
If IsEmpty(BUTTON_INFO) Then
InitializeButtons
End If
Dim btnName As String: btnName = Application.Caller
Select Case btnName
Case BUTTON_INFO(0)(0)
Application.StatusBar = BUTTON_INFO(0)(1) & "がクリックされました。"
' 初期化処理をここに追加
AddButtonsFromTemplate ActiveSheet.Name, 10, 2, "X", BUTTON_INFO, "BlackBTN"
Case BUTTON_INFO(1)(0)
Application.StatusBar = BUTTON_INFO(1)(1) & "がクリックされました。"
' データ取込処理をここに追加
AddButtonsFromTemplate ActiveSheet.Name, 10, 2, "Y", BUTTON_INFO, "OrangeBTN"
Case BUTTON_INFO(2)(0)
Application.StatusBar = BUTTON_INFO(2)(1) & "がクリックされました。"
' データ反映処理をここに追加
Call AddButton
Case Else
Application.StatusBar = "不明なボタンがクリックされました。"
End Select
ActiveSheet.Cells(1, 1).Select
End Sub
おまけ
使用例のイメージ画像があるとわかりやすいかと思ったので、投稿しておきます。
まず、Templateシートにボタンをいくつか用意しておきます。
- 続いて、上記のコードを実行して、出力されたボタン