LoginSignup
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

@jack-low(Jack Low)

ワンランク上のVBAを書いてみた その2

Last updated at Posted at 2024-08-01

まずはじめにやりたいこと。

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シートにボタンをいくつか用意しておきます。

  1. Templateシートに配置したボタン
    スクリーンショット 2024-08-02 004811.png
  • 続いて、上記のコードを実行して、出力されたボタン

  1. 初期配置のボタン
    スクリーンショット 2024-08-02 004836.png

  2. 横向き配置にセットしたボタン (Xを指定)
    スクリーンショット 2024-08-02 004825.png

  3. 縦向き配置 (Yを指定)
    スクリーンショット 2024-08-02 004831.png

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?