アドイン動作のサンプル

作り込む定型業務をアドイン化するためのアドイン呼び出しサンプルを作成しました。
2つの同じアドインを呼び出すワークブックと、呼ばれるアドインです。この3つをどこか同じフォルダに解凍してワークブック2つを開いて下さい。

サンプルの動作までの説明

ADDIN_TESTを解凍した所
(この画像をクリックするとこのページにサンプルがダウンロードできます。)

以前のページの説明でお解りのようにここで目的とするのは特定業務専用のアドインです。 従って、Excelに常駐するものではなく、必要なワークブックが開かれた時に背後でアドインが開かれる、 また、要求するワークブックがなくなったらそのアドインも閉じられる、というように動作するものとしてご覧ください。 「ADDIN_TEST1.xlsm」と「ADDIN_TEST2.xlsm」は同じ「ADDIN_TEST.xlam」というアドインを呼び出すワークブックです。

2ブックを開いた所

この画像は、「ADDIN_TEST1.xlsm」と「ADDIN_TEST2.xlsm」を開いたところです。 「ADDIN_TEST2.xlsm」の方は「Sheet2」を選択して見ました。
ツールバー制御もこのサンプルの特徴です。「Sheet1」が選択されている時は「処理1」「処理3」ボタンが有効になり、 「Sheet2」が選択されている時は「処理2」「処理4」ボタンが有効になるようにしてあります。 関係ないワークブックが選択された時はこのツールバーは表示されません。 他にツールバーを表示させる仕組みがなければ「アドイン」タブも表示されません。

ツールバーの動作が判るようにツールバー名も表示させています。 ツールバー名はワークブック名の拡張子無しとしていますが、これで1つのアドインから2つのツールバーが作成されていることが判ると思います。 さらに「ADDIN_TEST3.xlsm」などを作って開けば2つのツールバーが作成されます。 それぞれのツールバーは対象ワークブックのアクティブウィンドウにのみ表示されるようになっています。

Excel2013以降はSDIなのでウィンドウごとにリボンが表示されます。 それぞれのリボンのアドインタブに今回開いたアドインから表示されたツールバーが表示されるのです。 シートを切り替えたと時にボタンの有効/無効が切り替わる件はワークブックに対応したツールバーだけであって、 違うワークブックの方のワークブックは切り替わらないということも判ると思います。

Excel2010以前ではMDIなので、1つのExcelウィンドウの中に2つのワークブックが開きます。 最大化せずに並べたりズラせて表示させると2つのワークブックが見えますが、ツールバーは1つしか表示されません。
どちらのツールバーが表示されているかというと、手前に表示されているワークブックの名前のツールバーであることが判ります。 ここでワークブックの選択を切り替えるとツールバーも切り替わるのが判ると思います。

ここで関係ないワークブックを開くか、新規ワークブックを作成してみて下さい。
Excel2013以降ではツールバーは表示されず、他にツールバーを使う機能がなければアドインタブも表示されません。
Excel2010以前では今回開いたアドインから表示されたツールバーが消えるのが判ります。

ツールバーはアドインタブ内に作成されますが、今回よりアドインタブが自動選択されるように対応しました。

マクロの起動

手動でマクロを起動させようとしても「マクロ」には何も表示されません。

VBEditor画面

念のため、「Visual Basic Editor」を見ていただくと、「ADDIN_TEST.xlam」は1つしか起動されていないのが判ります。 同じブック名なので1つしか起動できないのは当然ですが。

さらにここで「ADDIN_TEST1.xlsm」と「ADDIN_TEST2.xlsm」を順に閉じていくと、 一方のみ閉じた時は「ADDIN_TEST.xlam」は開いたままとなり、 このアドインを要求するワークブックがすべて閉じられる時に「ADDIN_TEST.xlam」も閉じられます。

このような方法でアドイン化させる主目的は以下のようなことになります。
  • データが載ってしまったワークブックへのマクロの変更を最小限に防止する。
  • プログラムの機能更新は新しいアドインの上書きコピーだけで済む。
  • 複数のワークブックから同じアドインが呼ばれても問題なく対応できる。
  • 複数のワークブックから同じアドインが呼ばれるようにすればリソース軽減にもなる。
このページのサンプルではアドインは呼び出すワークブックと同じフォルダに配置されるようにしていますが、 これを社内ネットワーク上の一元的な場所に配置できればメンテナンスが発生しても1つのアドインだけ置き換えるだけで済むことになります。
アドインは一般利用ユーザーが更新することはないので、管理者以外の一般利用ユーザーからは「読み取り専用」でアクセス可能な場所があれば可能となります。 「http://」で参照するWebサーバに配置させることも可能です。

それではソースコードです。
まずは呼び出し元のワークブック側のソースコードですが、このサンプルではThisWorkbookだけに書かれています。

'***************************************************************************************************
'   アドインの動作テスト(ワークブックイベント記述)                  ThisWorkbook(Class)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'   [参照設定]
'   ・Microsoft Scripting Runtime
'***************************************************************************************************
' 変更日付 Rev   変更履歴内容---------------------------------------------------------------------->
' 04/11/13(1.0.0)新規作成
' 19/06/16(1.1.0)*.xlam版アドイン用に再作成
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsADDIN = "ADDIN_TEST.xlam"                    ' アドインファイル名
Private Const g_cnsSETTEI = "設定"                              ' 設定シート名
Private Const g_cnsPASS = "password"                            ' PW
Private g_swCLOSE As Boolean                                    ' CLOSE判定

'***************************************************************************************************
'   ■■■ ワークブックイベント ■■■
'***************************************************************************************************
'* 処理名 :Workbook_BeforeClose
'* 機能  :ブックClose前イベント
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = Cancel(Boolean)             ※Ref参照
'---------------------------------------------------------------------------------------------------
'* 作成日 :2004年11月13日
'* 作成者 :井上 治
'* 更新日 :2019年06月16日
'* 更新者 :井上 治
'* 機能説明:ツールバー削除の処理を呼び、必要ならアドインを閉じる
'* 注意事項:
'***************************************************************************************************
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    '-----------------------------------------------------------------------------------------------
    Const cnsTitle As String = "終了処理"
    Dim xlAPP As Application                                        ' Excel.Application
    Dim objWBK As Workbook                                          ' 本ブック
    Dim objSH_SETTEI As Worksheet                                   ' 設定シート
    Set xlAPP = Application
    Set objWBK = ThisWorkbook
    Set objSH_SETTEI = objWBK.Worksheets(g_cnsSETTEI)
    '-----------------------------------------------------------------------------------------------
    ' アドインが開かれていない場合は処理なし
    If objSH_SETTEI.Cells(1, 1).Value <> g_cnsADDIN Then Exit Sub
    '-----------------------------------------------------------------------------------------------
    ' 非保存の確認
    If Not objWBK.ReadOnly Then
        Select Case MsgBox("このブックは保存されていません。" & vbCr & _
            "保存して終了しますか?", vbYesNoCancel, cnsTitle)
            Case vbYes
                xlAPP.StatusBar = False
                objWBK.Save                 ' 上書き保存
            Case vbCancel
                Cancel = True               ' Closeをキャンセル
                Exit Sub
        End Select
    End If
    '-----------------------------------------------------------------------------------------------
    ' ツールバー削除の処理を呼ぶ(引数は本ブック名) ※アドイン削除指示が返る
    If xlAPP.Run("'" & g_cnsADDIN & "'!ToolBarDelete", objWBK.Name) Then
        ' アドイン削除指示の時はアドインをCLOSE
        On Error Resume Next
        xlAPP.Workbooks(g_cnsADDIN).Close False
    End If
    xlAPP.StatusBar = False
    g_swCLOSE = True
    objWBK.Saved = True                     ' 保存済みにする
End Sub

'***************************************************************************************************
'* 処理名 :Workbook_Open
'* 機能  :ワークブックOpen時イベント
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2004年11月13日
'* 作成者 :井上 治
'* 更新日 :2019年06月16日
'* 更新者 :井上 治
'* 機能説明:アドインを開き、初期処理マクロを起動する
'* 注意事項:
'***************************************************************************************************
Private Sub Workbook_Open()
    '-----------------------------------------------------------------------------------------------
    Dim objFso As FileSystemObject                                  ' FileSystemObject
    Dim xlAPP As Application                                        ' Excel.Application
    Dim objWBK As Workbook                                          ' 本ブック
    Dim objSH_SETTEI As Worksheet                                   ' 設定シート
    Dim strFilename As String                                       ' ファイル名
    Set objFso = New FileSystemObject
    Set xlAPP = Application
    Set objWBK = ThisWorkbook
    Set objSH_SETTEI = objWBK.Worksheets(g_cnsSETTEI)
    ' アドインが開いたかの判定スイッチをクリア
    objSH_SETTEI.Cells(1, 1).Value = ""                         ' アドインファイル名
    objSH_SETTEI.Cells(2, 1).Value = ""                         ' ツールバー名
    '-----------------------------------------------------------------------------------------------
    strFilename = objFso.BuildPath(objWBK.Path, g_cnsADDIN)
    ' アドインの存在確認(このサンプルではワークブックと同じフォルダ)
    ' ⇒多くのユーザーで共用する場合はそのアドインは共通フォルダに配置すべきです
    If Not objFso.FileExists(strFilename) Then
        ' 指定場所にアドインが存在しない
        ' ここでエラーにするか、そのままExitさせるかでアドインがない時の処置が違う
        ' 他の場所からアドインを開くという場合もある
        ' このサンプルでは設定シートのアドイン有無をクリアしているのでそのまま抜ける
        GoTo Open_AddinEXIT
    End If
    '-----------------------------------------------------------------------------------------------
    On Error GoTo Open_AddinError
    ' アドイン側の初期処理マクロの起動(引数は本ブック名)
    Call xlAPP.Run("'" & g_cnsADDIN & "'!InitialProc", objWBK.Name)
    GoTo Open_AddinEXIT

'===================================================================================================
' アドインが開かれていない時の処理
Open_AddinError:
    ' アドインを開く
    xlAPP.Workbooks.Open Filename:=strFilename, ReadOnly:=True, Password:=g_cnsPASS
    On Error GoTo 0
    ' 自ブックをアクティブに戻す
    objWBK.Activate
    Resume
'===================================================================================================
' 終了
Open_AddinEXIT:
    Set objFso = Nothing
End Sub

'***************************************************************************************************
'* 処理名 :Workbook_SheetActivate
'* 機能  :シート切替時イベント(Activate)
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = 対象シート(Object)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2004年11月13日
'* 作成者 :井上 治
'* 更新日 :2004年11月13日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    '-----------------------------------------------------------------------------------------------
    ' ツールバー状態制御
    Call Workbook_ToolBarEnable
End Sub

'***************************************************************************************************
'* 処理名 :Workbook_WindowActivate
'* 機能  :Window切替時イベント(Activate)
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = 対象Window(Window)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2004年11月13日
'* 作成者 :井上 治
'* 更新日 :2004年11月13日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub Workbook_WindowActivate(ByVal Wn As Window)
    '-----------------------------------------------------------------------------------------------
    ' ツールバー状態制御
    Call Workbook_ToolBarEnable
End Sub

'***************************************************************************************************
'* 処理名 :Workbook_WindowDeactivate
'* 機能  :Window切替時イベント(Deactivate)
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = 対象Window(Window)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2004年11月13日
'* 作成者 :井上 治
'* 更新日 :2004年11月13日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
    '-----------------------------------------------------------------------------------------------
    ' Close時は処理なし(削除したツールバーが再度表示されてしまうため)
    If g_swCLOSE = True Then Exit Sub
    ' ツールバー状態制御
    Call Workbook_ToolBarEnable
End Sub

'***************************************************************************************************
'   ■■■ 共通サブ処理 ■■■
'***************************************************************************************************
'* 処理名 :Workbook_ToolBarEnable
'* 機能  :ツールバー状態制御
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2004年11月13日
'* 作成者 :井上 治
'* 更新日 :2019年06月16日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub Workbook_ToolBarEnable()
    '-----------------------------------------------------------------------------------------------
    Dim objWBK As Workbook                                          ' 本ブック
    Dim objSH_SETTEI As Worksheet                                   ' 設定シート
    Set objWBK = ThisWorkbook
    Set objSH_SETTEI = objWBK.Worksheets(g_cnsSETTEI)
    '-----------------------------------------------------------------------------------------------
    ' アドインが開かれていない場合は処理なし
    If objSH_SETTEI.Cells(1, 1).Value <> g_cnsADDIN Then Exit Sub
    '-----------------------------------------------------------------------------------------------
    ' ツールバー状態制御
    On Error Resume Next
    Call Application.Run("'" & g_cnsADDIN & "'!ToolBarEnable", objWBK.Name)
End Sub

'------------------------------------------<< End of Source >>--------------------------------------
ワークシート切り替え、ウィンドウ切り替えの各イベント処理で全く同じ記述が発生するので、「Workbook_ToolBarEnable」という共通プロシージャを作成して集約させています。

※アドインはワークブックから呼び出された段階で、「設定」シートにアドイン名等を格納しています。(下記参照)
各イベントではこのセルにアドイン名があるかを判断して、ない場合(アドインが開かれていない)は、各イベントの先頭で処理を打ち切っているので、アドインが同一フォルダになければただのワークブックとして振る舞います。

次はアドイン側のソースコードですが、このサンプルではModule1のみです。
アドイン側のマクロは、上記のワークブック側のイベントで呼び出されて、ツールバーを作成したり、制御したりする部分と、実際にツールバーのボタン等が操作されて呼び出されるプロシージャを構成します。
このサンプルは、運用ワークブックとアドイン側プロシージャの呼び出し関係の説明だけなので、実際のツールバーのボタンで呼び出される処理はメッセージの表示だけにしてあります。

'***************************************************************************************************
'   アドインの動作テスト(アドイン側マクロ)                              Module1(Module)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'   [参照設定]
'   ・Microsoft Scripting Runtime
'   ・UIAutomationClient
'***************************************************************************************************
' 変更日付 Rev   変更履歴内容---------------------------------------------------------------------->
' 04/11/13(1.0.0)新規作成
' 19/06/16(1.1.0)*.xlam版アドインとして再作成
' 19/12/28(1.1.1)GP_ChangeAddinTabでタブ名取得時にTrimを追加する対応
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsTITLE As String = "アドインテスト"
'---------------------------------------------------------------------------------------------------
Private Const g_cnsVERSION As String = "1.1.1"                  ' バージョン
Private Const g_cnsUPDATE_DATE As Date = #12/28/2019#          ' バージョン更新日
'---------------------------------------------------------------------------------------------------
Private Const g_cnsSH1 As String = "Sheet1"
Private Const g_cnsSH2 As String = "Sheet2"
Private Const g_cnsSH3 As String = "設定"
Private Const g_cnsXLA As String = "ADDIN_TEST.xlam"
'---------------------------------------------------------------------------------------------------
' GP_SetObjectで確保される変数
Private g_xlAPP As Application                                  ' Excel.Application
Private g_WBK As Workbook                                       ' ワークブック
Private g_ADN As Workbook                                       ' 本アドイン
Private g_SH1 As Worksheet                                      ' Sheet1(ブック側)
Private g_SH2 As Worksheet                                      ' Sheet2(ブック側)
Private g_SH3 As Worksheet                                      ' 設定(ブック側)
Private g_strWbkName As String                                  ' ワークブック名

'***************************************************************************************************
'   ■■■ ブック側からのイベント起動処理 ■■■
'***************************************************************************************************
'* 処理名 :InitialProc
'* 機能  :初期処理(ブック側Openイベント起動)
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = ブック名(String)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2004年11月13日
'* 作成者 :井上 治
'* 更新日 :2019年06月16日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Public Sub InitialProc(ByVal strBookName As String)
    '-----------------------------------------------------------------------------------------------
    ' Object取得
    Call GP_SetObject(strBookName)
    ' 画面描画停止
    Call GP_StopScreen
    '-----------------------------------------------------------------------------------------------
    ' TODO: 初期処理でシート保護やマスタテーブルの読み込み等必要な処理を行なう
    '-----------------------------------------------------------------------------------------------
    ' アドインが開いたかの判定項目にアドイン名をセット
    g_SH3.Cells(1, 1).Value = g_cnsXLA
    ' 保存されているワークブックのバージョンが最新でない場合はバージョン更新を行なう
    If ((g_SH3.Cells(3, 1).Value < g_cnsVERSION) Or _
        (g_SH3.Cells(4, 1).Value < g_cnsUPDATE_DATE)) Then
        ' バージョン更新処理
        Call GP_VersionUP
    End If
    '-----------------------------------------------------------------------------------------------
    ' Sheet1を選択(これは例です)
    g_SH1.Select
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.ScrollRow = 1
    Cells(1, 1).Select
    '-----------------------------------------------------------------------------------------------
    ' ツールバー作成
    Call GP_ToolBarEnable(strBookName)
    ' 1秒後にアドインタブを選択する
    g_xlAPP.OnTime Now + TimeValue("00:00:01"), "GP_ChangeAddinTab"
End Sub

'***************************************************************************************************
'* 処理名 :ToolBarDelete
'* 機能  :終了処理(ブック側BeforeCloseイベント起動)
'---------------------------------------------------------------------------------------------------
'* 返り値 :アドイン削除指示(Boolean)
'* 引数  :Arg1 = ブック名(String)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2004年11月13日
'* 作成者 :井上 治
'* 更新日 :2019年06月16日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Public Function ToolBarDelete(ByVal strBookName As String) As Boolean
    '-----------------------------------------------------------------------------------------------
    Dim objWBK As Workbook                                          ' WORK
    Dim blnDel As Boolean                                           ' アドイン削除判定
    '-----------------------------------------------------------------------------------------------
    ' Object取得
    Call GP_SetObject(strBookName)
    '-----------------------------------------------------------------------------------------------
    blnDel = True
    ' 開いている他ブックが本アドインを使用しているか確認
    For Each objWBK In g_xlAPP.Workbooks
        ' 本ブックではなく、同じシート数である
        If ((objWBK.Name <> strBookName) And _
            (objWBK.Worksheets.Count = 3)) Then
            ' 3番目のシート名が「設定」でA1セルにアドイン名が登録されている
            If ((objWBK.Worksheets(3).Name = g_cnsSH3) And _
                (objWBK.Worksheets(3).Cells(1, 1).Value = g_cnsXLA)) Then
                blnDel = False
                Exit For
            End If
        End If
    Next objWBK
    '-----------------------------------------------------------------------------------------------
    If blnDel Then
        ' ホームタブを選択(アドイン削除の場合)
        Call GP_SelectRibbonTab("ホーム")
    End If
    '-----------------------------------------------------------------------------------------------
    ' ツールバー撤去
    Call GP_ToolBarDelete
    ' アドイン削除判定を返す
    ToolBarDelete = blnDel
End Function

'***************************************************************************************************
'* 処理名 :ToolBarEnable
'* 機能  :ツールバー状態制御処理(ブック側イベント起動)
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = ブック名(String)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2004年11月13日
'* 作成者 :井上 治
'* 更新日 :2019年06月16日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Public Sub ToolBarEnable(strBookName As String)
    '-----------------------------------------------------------------------------------------------
    ' Object取得
    Call GP_SetObject(strBookName)
    ' 画面描画停止
    Call GP_StopScreen
    ' ツールバー状態制御
    Call GP_ToolBarEnable(strBookName)
End Sub

'***************************************************************************************************
'   ■■■ カスタムツールバーからの呼び出し処理 ■■■
'***************************************************************************************************
'* 処理名 :CB_BUTTON1
'* 機能  :「処理1」ボタンの処理(カスタムツールバー起動)
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2004年11月13日
'* 作成者 :井上 治
'* 更新日 :2019年06月16日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub CB_BUTTON1()
    '-----------------------------------------------------------------------------------------------
    ' Object取得(実行時エラー等の対応のため再取得する)
    Call GP_SetObject
    '-----------------------------------------------------------------------------------------------
    ' ここで処理1がクリックされた時点の処理を記述する(ここではメッセージ表示のみ)
    MsgBox "「処理1」がクリックされました。" & vbCr & _
           "処理ブック=" & g_WBK.Name & vbCr & _
           "処理シート=" & ActiveSheet.Name, vbInformation, g_cnsTITLE
End Sub

'***************************************************************************************************
'* 処理名 :CB_BUTTON2
'* 機能  :「処理2」ボタンの処理(カスタムツールバー起動)
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2004年11月13日
'* 作成者 :井上 治
'* 更新日 :2019年06月16日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub CB_BUTTON2()
    '-----------------------------------------------------------------------------------------------
    ' Object取得(実行時エラー等の対応のため再取得する)
    Call GP_SetObject
    '-----------------------------------------------------------------------------------------------
    ' ここで処理2がクリックされた時点の処理を記述する(ここではメッセージ表示のみ)
    MsgBox "「処理2」がクリックされました。" & vbCr & _
           "処理ブック=" & g_WBK.Name & vbCr & _
           "処理シート=" & ActiveSheet.Name, vbInformation, g_cnsTITLE
End Sub

'***************************************************************************************************
'* 処理名 :CB_BUTTON3
'* 機能  :「処理3」ボタンの処理(カスタムツールバー起動)
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2004年11月13日
'* 作成者 :井上 治
'* 更新日 :2019年06月16日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub CB_BUTTON3()
    '-----------------------------------------------------------------------------------------------
    ' Object取得(実行時エラー等の対応のため再取得する)
    Call GP_SetObject
    '-----------------------------------------------------------------------------------------------
    ' ここで処理3がクリックされた時点の処理を記述する(ここではメッセージ表示のみ)
    MsgBox "「処理3」がクリックされました。" & vbCr & _
           "処理ブック=" & g_WBK.Name & vbCr & _
           "処理シート=" & ActiveSheet.Name, vbInformation, g_cnsTITLE
End Sub

'***************************************************************************************************
'* 処理名 :CB_BUTTON4
'* 機能  :「処理4」ボタンの処理(カスタムツールバー起動)
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2004年11月13日
'* 作成者 :井上 治
'* 更新日 :2019年06月16日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub CB_BUTTON4()
    '-----------------------------------------------------------------------------------------------
    ' Object取得(実行時エラー等の対応のため再取得する)
    Call GP_SetObject
    '-----------------------------------------------------------------------------------------------
    ' ここで処理4がクリックされた時点の処理を記述する(ここではメッセージ表示のみ)
    MsgBox "「処理4」がクリックされました。" & vbCr & _
           "処理ブック=" & g_WBK.Name & vbCr & _
           "処理シート=" & ActiveSheet.Name, vbInformation, g_cnsTITLE
End Sub

'***************************************************************************************************
'   ■■■ サブ処理 ■■■
'***************************************************************************************************
'* 処理名 :GP_SetObject
'* 機能  :Bookオブジェクト取得
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = ブック名(String)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2004年11月13日
'* 作成者 :井上 治
'* 更新日 :2019年06月17日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub GP_SetObject(Optional ByVal strBookName As String)
    '-----------------------------------------------------------------------------------------------
    ' ブック名確保済みなら処理無し
    If ((strBookName <> "") And (strBookName = g_strWbkName)) Then Exit Sub
    Set g_xlAPP = Application                                   ' Excel.Application
    ' ブック名が指定されているか
    If strBookName <> "" Then
        Set g_WBK = g_xlAPP.Workbooks(strBookName)              ' 処理ワークブック
    Else
        Set g_WBK = ActiveWorkbook
    End If
    g_strWbkName = g_WBK.Name                                   ' 処理ワークブック名
    Set g_ADN = ThisWorkbook                                    ' 本アドイン
    Set g_SH1 = g_WBK.Worksheets(g_cnsSH1)                      ' Sheet1シート(ブック側)
    Set g_SH2 = g_WBK.Worksheets(g_cnsSH2)                      ' Sheet2シート(ブック側)
    Set g_SH3 = g_WBK.Worksheets(g_cnsSH3)                      ' 設定シート(ブック側)
End Sub

'***************************************************************************************************
'* 処理名 :GP_ToolBarEnable
'* 機能  :カスタムツールバーの状態制御
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = ブック名(String)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2004年11月13日
'* 作成者 :井上 治
'* 更新日 :2019年06月16日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub GP_ToolBarEnable(Optional ByVal strBookName As String)
    '-----------------------------------------------------------------------------------------------
    Dim objCBar As CommandBar                                       ' カスタムツールバー
    Dim objButton As CommandBarButton                               ' ボタン
    Dim objSh As Worksheet                                          ' 対象シート
    Dim intIx As Integer                                            ' テーブルINDEX
    '-----------------------------------------------------------------------------------------------
    ' ツールバー取得
    On Error GoTo ToolBarEnable_ERROR
    Set objCBar = g_xlAPP.CommandBars(g_SH3.Cells(2, 1).Value)
    ' ツールバーを非表示にできなくする
    objCBar.Protection = msoBarNoChangeVisible
    On Error GoTo 0
    '-----------------------------------------------------------------------------------------------
    ' ツールバー上のボタン制御(例)
    With objCBar
        ' 現在ブックが異なるか
        If ActiveWorkbook.Name <> strBookName Then
            ' 自ブックがアクティブでない場合は全ボタンをFalseにする
            For intIx = 1 To 4
                .Controls(intIx).Enabled = False
            Next intIx
            ' ツールバーを非表示にする
            .Visible = False
        Else
            ' 自ブックがアクティブの時はSelectedシートによりボタンを制御
            Select Case ActiveSheet.Name
                Case g_cnsSH1               ' Sheet1
                    ' [例]処理1と処理3を有効にする
                    .Controls(1).Enabled = True                 ' 処理1
                    .Controls(2).Enabled = False                ' 処理2
                    .Controls(3).Enabled = True                 ' 処理3
                    .Controls(4).Enabled = False                ' 処理4
                Case g_cnsSH2               ' Sheet2
                    ' [例]処理2と処理4を有効にする
                    .Controls(1).Enabled = False                ' 処理1
                    .Controls(2).Enabled = True                 ' 処理2
                    .Controls(3).Enabled = False                ' 処理3
                    .Controls(4).Enabled = True                 ' 処理4
                Case Else                   ' その他
                    ' Sheet1,Sheet2以外は全ボタンをFalseにする
                    For intIx = 1 To 4
                        .Controls(intIx).Enabled = False
                    Next intIx
            End Select
            .Controls(5).Enabled = False                        ' ツールバー名
            .Visible = True
        End If

    End With
    GoTo ToolBarEnable_EXIT

'===================================================================================================
'   エラー処理
ToolBarEnable_ERROR:
    ' ツールバー作成
    Call GP_SetToolbar(strBookName)
    Resume

'===================================================================================================
'   終了
ToolBarEnable_EXIT:
    Set objCBar = Nothing
    ' 画面描画再開
    If g_xlAPP.ScreenUpdating <> True Then Call GP_StartScreen
    On Error GoTo 0
End Sub

'***************************************************************************************************
'* 処理名 :GP_SetToolbar
'* 機能  :カスタムツールバーの作成
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = ブック名(String)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2004年11月13日
'* 作成者 :井上 治
'* 更新日 :2019年06月16日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub GP_SetToolbar(Optional ByVal strBookName As String)
    '-----------------------------------------------------------------------------------------------
    Dim objCBar As CommandBar                                       ' カスタムツールバー
    Dim lngPos As Long                                              ' 文字位置Work
    Dim strBarName As String                                        ' カスタムツールバー名
    '-----------------------------------------------------------------------------------------------
    ' カスタムツールバーの名称を編集(名称はブック名の拡張子抜き)
    If strBookName <> "" Then
        lngPos = InStrRev(strBookName, ".")
        strBarName = Left(strBookName, lngPos - 1)
        ' 同一ブック再OPEN対応
        On Error Resume Next
        Set objCBar = g_xlAPP.CommandBars(strBarName)
        ' 当該ツールバーが既に存在する場合はこのまま終了
        If Err.Number = 0 Then
            g_SH3.Cells(2, 1).Value = strBarName
            GoTo GET_SetToolBar_EXIT
        End If
    Else
        lngPos = InStrRev(g_WBK.Name, ".")
        strBarName = Left(g_WBK.Name, lngPos - 1)
    End If
    '-----------------------------------------------------------------------------------------------
    On Error GoTo GET_SetToolBar_ERROR
    ' カスタムツールバーを追加
    Set objCBar = g_xlAPP.CommandBars.Add(strBarName, msoBarTop, False, True)
    g_SH3.Cells(2, 1).Value = strBarName
    On Error GoTo 0
    '-----------------------------------------------------------------------------------------------
    ' 処理1(Index=1)
    Call GP_SetButton(objCBar, "[ 処理1 ](&1)", _
        "[処理1]はSheet1が選択中のみクリックできます。", "CB_BUTTON1", False)
    ' 処理2(Index=2)
    Call GP_SetButton(objCBar, "[ 処理2 ](&2)", _
        "[処理2]はSheet2が選択中のみクリックできます。", "CB_BUTTON2", True)
    ' 処理3(Index=3)
    Call GP_SetButton(objCBar, "[ 処理3 ](&3)", _
        "[処理3]はSheet1が選択中のみクリックできます。", "CB_BUTTON3", True)
    ' 処理4(Index=4)
    Call GP_SetButton(objCBar, "[ 処理4 ](&4)", _
        "[処理4]はSheet2が選択中のみクリックできます。", "CB_BUTTON4", True)
    ' Dummy(Index=5:ツールバー名の表示)
    Call GP_SetButton(objCBar, "BarName=" & strBarName, _
        "これが現在のツールバー名です。", "", True)
    GoTo GET_SetToolBar_EXIT

'===================================================================================================
GET_SetToolBar_ERROR:
    ' ツールバーが存在する場合は削除して作り直す
    Call GP_ToolBarDelete
    Resume

'===================================================================================================
GET_SetToolBar_EXIT:
    Set objCBar = Nothing
    On Error GoTo 0
End Sub

'***************************************************************************************************
'* 処理名 :GP_SetButton
'* 機能  :カスタムツールバー上のボタンセット
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = カスタムツールバー(Object)
'*      Arg2 = ボタン表示名(String)
'*      Arg3 = TooltipText(String)
'*      Arg4 = 実行プロシージャ(String)
'*      Arg5 = グループの始まり(Boolean)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2004年11月13日
'* 作成者 :井上 治
'* 更新日 :2004年11月13日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub GP_SetButton(ByRef objCBar As CommandBar, _
                         ByVal strCaption As String, _
                         ByVal strTipText As String, _
                         ByVal strOnAction As String, _
                         ByVal blnTrue As Boolean)
    '-----------------------------------------------------------------------------------------------
    Dim objCont As CommandBarControl                                ' CommandBarControl
    Dim objButton As CommandBarButton                               ' CommandBarButton
    '-----------------------------------------------------------------------------------------------
    ' ツールバー上にボタンを追加
    Set objCont = objCBar.Controls.Add(Type:=msoControlButton, Temporary:=True)
    ' グループの始まり
    objCont.BeginGroup = blnTrue
    '-----------------------------------------------------------------------------------------------
    Set objButton = objCont
    ' ボタン上の設定
    With objButton
        .Style = msoButtonCaption                           ' ボタン名を表示
        .Caption = strCaption                               ' ボタン表示名
        .TooltipText = strTipText                           ' ツールチップテキスト
        .OnAction = strOnAction                             ' クリック時のプロシージャ名
    End With
    Set objButton = Nothing
    Set objCont = Nothing
End Sub

'***************************************************************************************************
'* 処理名 :GP_ToolBarDelete
'* 機能  :カスタムツールバーの削除
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2004年11月13日
'* 作成者 :井上 治
'* 更新日 :2004年11月13日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub GP_ToolBarDelete()
    '-----------------------------------------------------------------------------------------------
    Dim objCBar As CommandBar                                       ' カスタムツールバー
    On Error GoTo ToolBarDelete_EXIT
    Set objCBar = g_xlAPP.CommandBars(g_SH3.Cells(2, 1).Value)
    ' ツールバーを削除
    objCBar.Delete

'===================================================================================================
ToolBarDelete_EXIT:
    ' ツールバー名を消去
    g_SH3.Cells(2, 1).Value = ""
    ' ツールバーがない場合は無視
    Set objCBar = Nothing
    On Error GoTo 0
End Sub

'***************************************************************************************************
'* 処理名 :GP_ChangeAddinTab
'* 機能  :アドインタブの選択(Application.OnTime起動)
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2019年06月16日
'* 作成者 :井上 治
'* 更新日 :2019年06月16日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub GP_ChangeAddinTab()
    '-----------------------------------------------------------------------------------------------
    ' アドインタブを選択
    Call GP_SelectRibbonTab("アドイン")
End Sub

'***************************************************************************************************
'* 処理名 :GP_SelectRibbonTab
'* 機能  :リボンの指定名タブを選択
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = タブ名(String)
'*      Arg2 = リボン最小化時も実行(Boolean)           ※Option
'---------------------------------------------------------------------------------------------------
'* 作成日 :2019年06月16日
'* 作成者 :井上 治
'* 更新日 :2019年12月28日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:[参照設定]UIAutomationClient、Excelが起動していない状態からの直接起動では働かない
'***************************************************************************************************
Private Sub GP_SelectRibbonTab(ByVal strTabname As String, _
                               Optional ByVal blnEnableWhenMinimum As Boolean = False)
    '-----------------------------------------------------------------------------------------------
    Dim objCuiAuto As UIAutomationClient.CUIAutomation                          ' CUIAutomation
    Dim objRibbon As UIAutomationClient.IUIAutomationElement                    ' リボン
    Dim objRibbonTab As UIAutomationClient.IUIAutomationElement                 ' リボンタブ
    Dim objUiCondition As UIAutomationClient.IUIAutomationCondition             ' UiCondition
    Dim tblRibbonTab As UIAutomationClient.IUIAutomationElementArray            ' タブテーブル
    Dim objAccPtn As UIAutomationClient.IUIAutomationLegacyIAccessiblePattern   ' AccessiblePattern
    Dim objIAccessible As Office.IAccessible                                    ' IAccessible
    Dim lngIx As Long                                                           ' テーブルINDEX
    Dim lngIxMax As Long                                                        ' テーブルINDEX上限
    '-----------------------------------------------------------------------------------------------
    ' リボンが最小化していたら何もしない(最小化が解除されてしまうため)
    If Not blnEnableWhenMinimum And Application.CommandBars.GetPressedMso("MinimizeRibbon") Then
        Exit Sub
    End If
    '-----------------------------------------------------------------------------------------------
    ' リボンの取得
    Set objCuiAuto = New UIAutomationClient.CUIAutomation
    Set objIAccessible = Application.CommandBars("Ribbon")
    Set objRibbon = objCuiAuto.ElementFromIAccessible(objIAccessible, 0)
    ' リボンタブの取得(配列)
    Set objUiCondition = objCuiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "NetUIRibbonTab")
    Set tblRibbonTab = objRibbon.FindAll(TreeScope_Subtree, objUiCondition)
    lngIxMax = tblRibbonTab.Length - 1
    '-----------------------------------------------------------------------------------------------
    ' タブを巡回
    Do While lngIx <= lngIxMax
        ' 指定タブ名か
        If Trim(tblRibbonTab.GetElement(lngIx).CurrentName) = strTabname Then Exit Do
        ' 次へ
        lngIx = lngIx + 1
    Loop
    ' 指定タブ名がなければ終了
    If lngIx > lngIxMax Then Exit Sub
    '-----------------------------------------------------------------------------------------------
    ' 指定タブを選択
    Set objRibbonTab = tblRibbonTab.GetElement(lngIx)
    Set objAccPtn = objRibbonTab.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)
    objAccPtn.DoDefaultAction
End Sub

'***************************************************************************************************
'* 処理名 :GP_StopScreen
'* 機能  :画面描画停止
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2004年11月13日
'* 作成者 :井上 治
'* 更新日 :2004年11月13日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub GP_StopScreen()
    '-----------------------------------------------------------------------------------------------
    With g_xlAPP
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
'        .EnableCancelKey = xlDisabled              ' テスト中はコメントアウト
    End With
End Sub

'***************************************************************************************************
'* 処理名 :GP_StartScreen
'* 機能  :画面描画再開
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2004年11月13日
'* 作成者 :井上 治
'* 更新日 :2004年11月13日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub GP_StartScreen()
    '-----------------------------------------------------------------------------------------------
    With g_xlAPP
        .EnableCancelKey = xlInterrupt
        If .Calculation <> xlCalculationAutomatic Then
            .Calculation = xlCalculationAutomatic
        End If
        .StatusBar = False
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

'***************************************************************************************************
'* 処理名 :GP_VersionUP
'* 機能  :バージョン更新処理
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2004年11月13日
'* 作成者 :井上 治
'* 更新日 :2004年11月13日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub GP_VersionUP()
    '-----------------------------------------------------------------------------------------------
    ' バージョンによってワークブックを更新する必要がある場合はここに低い方から記述する
    'If g_SH3.Cells(3, 1).Value < "1.01" Then

    '-----------------------------------------------------------------------------------------------
    ' 新しいバージョンの登録
    g_SH3.Cells(3, 1).Value = g_cnsVERSION                  ' バージョン
    g_SH3.Cells(4, 1).Value = g_cnsUPDATE_DATE              ' バージョン更新日
End Sub

'------------------------------------------<< End of Source >>--------------------------------------

この他、バージョンの更新をアドインの上書きコピーだけで済ませるため、バージョンの更新の際にワークブック側の変更が発生した場合に備えて、「バージョン更新処理(GP_VersionUP)」を用意しておきます。
この処理は、アドインプロシージャの定数(バージョンナンバー、更新日)と、前回の更新(又は運用初回)で記録されている「設定」シートの値(バージョンナンバー、更新日)を比較して差異があった時だけ動作します。ここにワークブック側に必要な更新内容(例えば計算式の変更等)をバージョンの歴代の判断記述に含めて記述しておきます。

場合によっては、年次を超えて継続的に利用される定例的業務をこのようなマクロを使った仕組みで大勢に配布した状態で運用することがありますが、アドインの更新は単にバグによる不具合の修正といった用途ではなく、会社としての制度変更の対応、法律的な対応なども含まれるので配慮の上で重要な要素だと思います。

このアドインでの仕組みは、私の約15年以上の経験の「集大成」でもあります。アドイン化に手を染めたのは、Excelを経験し始めてかなり浅い段階でしたが、当時はExcel95がまだ無視できない段階で、ワークブックからアドインへの処理の指示が難しい状態でした。なにしろこのサンプルようにアドインからツールバーを表示させて直接アドイン側に操作者が指示するなどはできないわけで、ワークシートのフォームの「ボタン」等を貼っての動作でした。(当時の私の未熟も影響しています)
当時は、各「ボタン」とも単一のプロシージャ(ワークブック側のモジュール)を呼ぶことにし、そのプロシージャでAppication.Callerを引数にアドインのプロシージャに引き継ぎ、「どのボタンから呼ばれたか」を判定する方法を採っておりました。
当然、「複数のワークブック」など対応もできなく、閉じる時もアドインは残したままでした。

現在のサンプルではこのアドイン側の上から2番目の「ToolBarDelete」プロシージャで、閉じようとしているワークブック以外にこのアドインを必要としているワークブックがあるかをシート数やシート名、特定セルの値で判断させており、 アドインを閉じる操作はアドイン自身では行なわずにワークブック側にアドインを閉じて良いかの判定値を返しています。
以前のバージョンではこの判断をワークブック側で行なっていたのですが、本来処理は極力アドイン側で行ない、ワークブック側では細かい判断等は行なわない趣旨なのでアドイン側に移したものです。

実際にアドインを作成する場合は、普通のワークブック(シートは特に使用しない)として作成して下さい。「ダウンロード」のページにExcelテンプレート・アドイン作成」を用意してあるので、これを使ってワークブックからアドインが作成できます。ワークブックはそのまま残るので機能改変やメンテナンスにもそのまま利用できます。