[Excel] エクセルのアドイン作成テンプレート

このひな形一つで「右クリックメニューが追加され、選択するとマクロ関数（サブルーチン）が呼び出される」Excelのアドインが作れます。ちょっとした作業自動化にうってつけです。

Excelのアドインについて

• xlaファイル：インストールせずに一時的に利用できるアドイン。xlaファイルを直接開くことで動作開始。Excelを全て閉じたら動作終了する。

中身はExcel VBAのマクロだが、ブック（xlsx,xlsmファイル)に依存しないので、ブックをコピーしてロジック複製されるといったことが回避できます。アドインファイルに書き込みロックもできるので、「知らず知らずにExcel編集してるうちに誤ってマクロを壊しちゃった」なんて危険を回避できます。
「xlax」ではないのは、都合により・・

• アドインの追加：xlaファイルはExcelを全て閉じたら終了してしまうので、また起動する度に毎回開く必要がある。それが面倒な場合は、「アドインの追加」を行えばアドインの削除を行うまでxlaファイルの動作が有効になる。

ひな形

以下の記述を「標準モジュール」にコピペしてxlaファイルとして保存すれば出来上がり。理解できた人はそのままお持ち帰りください。（xlaファイルの作り方は後述）

アドイン雛

Const HEAD_TITLE = "ハローワールド" 'コンテキストメニューのタイトル
Const MENU = "ハロー,ワールド" 'サブメニューのタイトル（カンマ区切り）
Const MENU_ACT = "hello,world" 'サブメニューのSub名（カンマ区切り）

'ここに関数挿入

Sub hello()

    MsgBox "Hello," & Selection

End Sub

Sub world()

    MsgBox Selection & " World!"

End Sub


'以降、共通処理

Sub Auto_Open()
    AddMenu
End Sub

Sub Auto_Close()

End Sub

Sub EditCode()
    SendKeys "%{F11}"
End Sub

Sub AddMenu()
    On Error Resume Next
    Dim aMenu() As String
    Dim aMenuAct() As String

    Dim codeEditName As String
    codeEditName = "> マクロ編集"

    If Not IsControl(HEAD_TITLE) Then
        Set contextmenu = Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup, Temporary:=True)
        With contextmenu
            .Caption = HEAD_TITLE
            .BeginGroup = False
        End With
        With contextmenu.Controls.Add(Temporary:=True)
            .Caption = codeEditName
            .OnAction = "EditCode"
            .BeginGroup = True
        End With
    End If

    Set contextmenu = Application.CommandBars("Cell").Controls(HEAD_TITLE)
    With contextmenu
        aMenu = Split(MENU, ",")
        aMenuAct = Split(MENU_ACT, ",")

        For i = 0 To UBound(aMenu)
            If Not IsSubControl(aMenu(i)) Then
                bidx = contextmenu.Controls(codeEditName).Index
                With .Controls.Add(Temporary:=True, Before:=bidx)
                    .Caption = aMenu(i)
                    .OnAction = aMenuAct(i)
                End With
            End If
        Next
    End With
End Sub

Function IsControl(name As String) As Boolean
    Dim found As Boolean

    For Each c In Application.CommandBars("Cell").Controls
        If c.Caption = name Then
            found = True
        End If
    Next c
    IsControl = found
End Function

Function IsSubControl(name As String) As Boolean
    On Error GoTo ex
    Dim found As Boolean
    found = False
    For Each c In Application.CommandBars("Cell").Controls(HEAD_TITLE).Controls
        If c.Caption = name Then
            found = True
        End If
    Next c

ex:
    IsSubControl = found
End Function

xlaファイルの作成方法

1. Excelを起動し、空白のブックを開く。
2. Alt + F11 キーを押してマクロのプログラム画面を開く
3. 左側「プロジェクト」メニューから「VBAProject(Book1)」の記述をを見つけ、右クリック > 挿入 > 標準モジュールを選択する。　（「Book1」は新規に開いたブックの名称です）
4. 右側に挿入した新規標準モジュール（空白エリア）ができるので、そこに先程のコードを張り付ける。
5. Ctrl + S キーを押して任意の場所に保存する（※「ファイルの種類」は「Excel 97-2003 アドイン(*.xla)」を選択）
6. 保存したxlaファイルをダブルクリックで開く。
7. 開いていいかどうかの確認ダイアログが出るのでOKする。（※知らないファイルには実施しない事）
8. 右クリックメニューが表示されていることを確認

注意点

配布したアドインを開くと、無反応で動かなくなる現象

セキュリティ制限がかかっている場合、動作が無反応になり、ハマりどころとなっております。

• xlaファイルを右クリック・プロパティを開く
• 「全般」タブの下「属性」辺りに「セキュリティの解除」なる表記がある場合それをチェックし、「OK」で反映する。（※もちろん知らないファイルには実施しない事）
• 再び開くと動作すると思われます。

おまけ。「アドインの追加」を行うアドイン

以下コードを同様に「xlaファイルの作成方法」と同様の手順で作成すると、インストーラ・アンインストーラの様になります。
※ファイル名を基準に動作するので、ファイル名はタイトル記載通りにしてください。
※インストーラはxlaファイルと同位置に配置してください。
※手動でできること（アドインの追加・削除）をマクロでやっているだけなので、動作しない場合は手動で実施してください。

Install_【インストールするxlaのファイル名（拡張子抜き)】.xla

Sub Auto_Open()
    On Error GoTo ex

    If IsAddin(GetName()) Then
        MsgBox "既にアドインが起動されているので、続行できません。"
        Exit Sub
    End If

    If MsgBox(GetName() & "をExcelアドインに追加します。よろしいですか？", vbYesNo) = vbNo Then Exit Sub

    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CopyFile ThisWorkbook.Path & "\" & GetName() & ".xla", Application.UserLibraryPath & GetName() & ".xla"
    Set fso = Nothing

    Set myaddin = AddIns.Add(Filename:=Application.UserLibraryPath & GetName() & ".xla")
    myaddin.Installed = True

    MsgBox "Excelアドインを追加しました。次回起動時に有効になります。"

    Exit Sub
ex:
    MsgBox "アドインを追加できませんでした。Excelを開いた状態でInstallを実行してください。"
End Sub

Function IsAddin(name As String) As Boolean
    On Error GoTo ex
    IsAddin = False
    If AddIns(name).Installed = True Then
        IsAddin = True
    End If
ex:
End Function

Function GetName()
    Dim aNam() As String
    aNam = Split(Split(ThisWorkbook.name, ".")(0), "_", 2)
    GetName = aNam(1)
End Function

Uninstall_【アンインストールするxlaのファイル名（拡張子抜き)】.xla

Sub Auto_Open()
    On Error Resume Next

    Dim name As String
    name = GetName()

    If MsgBox(name & "をExcelアドインから削除します。よろしいですか？ ", vbYesNo) = vbNo Then Exit Sub

    Application.AddIns(name).Installed = False

    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.DeleteFile Application.UserLibraryPath & name & ".xla"
    Set fso = Nothing

    Application.CommandBars("Cell").Controls(name).Delete

    MsgBox "削除が完了しました。もし削除されていない場合は、Excelをすべて閉じた後に再度実行してください。"

End Sub

Function GetName()
    Dim aNam() As String
    aNam = Split(Split(ThisWorkbook.name, ".")(0), "_", 2)
    GetName = aNam(1)
End Function