実用(?)マクロ集

Sub MyFuncInit()
    Const FuncTable As String = "関数表!A1"
    Const TbarName As String = "MyToolBar"
    Const TpopName As String = "MyFunc"
    Const TbtnCap As Integer = 1
    Const TbtnAct As Integer = 2
    Dim Tbar As CommandBar
    Dim Tbtn As CommandBarButton
    Dim r As Range
    For Each Tbar In Application.CommandBars
        If Tbar.Name = TbarName Then Tbar.Delete
    Next Tbar
    Set Tbar = Application.CommandBars.Add(Name:=TbarName).Controls.Add(Type:=msoControlPopup).CommandBar
    With Tbar
        .Parent.Caption = TpopName
        For Each r In Range(FuncTable).CurrentRegion.Rows
            Set Tbtn = .Controls.Add(Type:=msoControlButton)
            With Tbtn
                .Style = msoButtonCaption
                .Caption = r.Columns(TbtnCap).Text
                .OnAction = r.Columns(TbtnAct).Text
            End With
        Next r
        .Parent.Parent.Visible = True
    End With
End Sub

Option Explicit

Public Btn As CommandBarButton

'ボタンの作成
Public Sub Init()
    Set Btn = CommandBars(1).Controls.Add(msoControlButton)
    With Btn
        .OnAction = "Test"
        .Style = msoButtonCaption
        .Caption = "Click!"
    End With
End Sub

'ボタンが押されたらそのボタンが現在作ったボタン(btn)かどうか確認する。
Public Sub Test()
    If isActiveButton(Btn) = False Then
        MsgBox "アクティブではありませんでした。" '非アクティブ時の処理
    End If
    MsgBox "OK" ' 本来の処理
End Sub

'ボタンの重複チェック。同じボタンだったら、Trueを返す。
'ActivateがTrue(既定)の場合、違うボタンの場合は削除して、現在のボタンをBtnに設定し、
'Btnが存在しない場合も現在のボタンをBtnに設定する。
'Activateが
Private Function isActiveButton(Btn As CommandBarButton, Optional Activate As Boolean = True) As Boolean
    Dim ActBtn As CommandBarButton
    Set ActBtn = CommandBars.ActionControl
    If Not Btn Is Nothing Then
        If Not (Btn.Parent.Index = ActBtn.Parent.Index And Btn.Index = ActBtn.Index) Then
            If Activate Then
                Btn.Delete
                Set Btn = ActBtn
            End If
            isActiveButton = False
        Else
            isActiveButton = True
        End If
    Else
        If Activate Then Set Btn = ActBtn
        isActiveButton = False
    End If
End Function

'   関数名：OpenFileFolder
'   引数：  なし
'   説明：  現在使用しているファイルのあるフォルダをExplorerで開きます。
'
Sub OpenFileFolder()
    Shell "explorer.exe """ & ActiveWorkbook.Path & """", vbNormalFocus
End Sub