【VBA】エクセルでメニューボタン

VBAで作成したシェイプを作成し、各シェイプにマクロを設定します。

今回の例ではメニューボタンを好きな位置に設置することが出来ます。
実用的には各シートの名前をメニューボタンにするような使い方でしょうか。

やっていること

• 最初の図形を用意すしてマクロを設定しておく
• クリックした図形の位置の下に図形を新規作成する
• 図形を作成すると同時にマクロも設定する

メニューを開く処理

メニューボタンの「開く」「閉じる」切り替え

    'メニューボタンのシェイプを取得
    Dim shpMenu As Shape
    Set shpMenu = ActiveSheet.Shapes(Application.Caller)

    'ボタンON/OFF
    If shpMenu.TextFrame.Characters.Text = "閉じる" Then
        Call 削除_シェイプ
        shpMenu.Fill.ForeColor.RGB = rgbDodgerBlue
        shpMenu.TextFrame.Characters.Font.color = rgbWhite
        shpMenu.TextFrame.Characters.Text = "開く"
        Exit Sub
    Else
        shpMenu.Fill.ForeColor.RGB = rgbWhite
        shpMenu.TextFrame.Characters.Font.color = rgbDodgerBlue
        shpMenu.TextFrame.Characters.Text = "閉じる"
    End If

メニューの名前と位置を指定する

    '今回は配列を使用
    Dim メニュー(1 To 6) As String
    メニュー(1) = "移動"
    メニュー(2) = "回転"
    メニュー(3) = "増殖"
    メニュー(4) = "伸縮"
    メニュー(5) = "色変"
    メニュー(6) = "拡大"
    
    'メニューの位置とサイズを指定する
    
    '左位置はメニューボタンと同じ位置
    Dim l As Single
    l = shpMenu.Left
    
    '上位置はメニューボタンから5ポイント離した位置
    Dim t As Single
    t = shpMenu.Top + shpMenu.Height + 5
    
    '横幅はメニューボタンと同じ幅
    Dim w As Single
    w = shpMenu.Width
    
    '縦幅はメニューボタンと同じ幅
    Dim h As Single
    h = shpMenu.Height

メニューを開く処理

    'メニューを作成
    Dim shp As Shape
    Dim n As Long
    For n = 1 To UBound(メニュー())
        Set shp = ActiveSheet.Shapes.AddShape(Type:=msoShapeRectangle, _
            Left:=l, Top:=t, Width:=w, Height:=h)
        With shp
            .name = "シェイプ" & n
            .Fill.ForeColor.RGB = rgbDodgerBlue '塗りつぶし色
            .Line.Visible = msoFalse '線無し
            .ControlFormat.PrintObject = True '印刷される設定
            With .TextFrame
                .Characters.Text = メニュー(n) 'テキスト
                .Characters.Font.color = vbWhite 'テキスト色
                .Characters.Font.Size = 18 'フォントサイズ
                .Characters.Font.Bold = True '太字
                .Characters.Font.Shadow = False 'フォントの影
                .HorizontalAlignment = xlHAlignCenter '左右中央揃え
                .VerticalAlignment = xlVAlignCenter '上下中央揃え
                .HorizontalOverflow = xlOartHorizontalOverflowOverflow '横にはみ出して表示
                .MarginLeft = 0 '左余白
                .MarginRight = 0 '右余白
                .MarginTop = 0 '上余白
                .MarginBottom = 0 '下余白
            End With
            'フォント
            With .TextFrame2
                .TextRange.Font.name = "Meiryo UI" '英字フォント設定
                .TextRange.Font.NameFarEast = "Meiryo UI" '日本語フォント設定
                .WordWrap = msoFalse '図形内でテキストを折り返さない
            End With
            '影
            With .Shadow
                .Visible = True
                .Transparency = 0.2
                .OffsetX = 2
                .OffsetY = 2
                .Blur = 3
            End With
            'シェイプにマクロ設定
            .OnAction = "S" & メニュー(n)
        End With
        t = t + h + 5
        '処理を遅延させる
        Application.Wait [Now()] + 10 / 86400000
    Next n