Excelアドインで右クリックメニューを独自作成する

# 1. はじめに
* Excelの右クリックメニューに独自メニューを追加したい
* 右クリックメニューから別Excelファイルを開きたい
* 右クリックメニューから別PDFファイルを開きたい

# 2. 開発環境
* Excel for Microsoft 365 (バージョン：2304)
* Excel VBA

# 3. Excelマクロ
```vb:
Option Explicit

Public ADDIN_NAME As String             ' アドイン名
Public ADDIN_FILE_NAME As String        ' アドインファイル名
Public MENU_RIGHT_CLICK As String       ' 右クリックメニュー名
Public EXCEL_FILE As String             ' Excelファイル
Public PDF_FILE As String               ' PDFファイル


' 初期処理
Public Sub Init()

    ' 変数設定
    ADDIN_NAME = "サンプルアドインツール"
    ADDIN_FILE_NAME = "サンプルアドインツール.xlam"
    MENU_RIGHT_CLICK = "サンプルメニュー"
    EXCEL_FILE = "C:\temp\サンプルExcelファイル.xlsx"
    PDF_FILE = "C:\temp\Adobe Acrobat Pro DC.pdf"
    
    ' WSHオブジェクト
    Dim wsh As Object
    Set wsh = CreateObject("WScript.Shell")
    
    ' 特殊フォルダのパスを格納する変数
    Dim path As String
    path = wsh.SpecialFolders("MyDocuments")
    path = wsh.SpecialFolders(16)
    
End Sub

' アドイン追加
Public Sub SaveAddin()

    Dim savePath As String
    
    ' アドイン登録済の場合、無効にする
    If IsExistAddin() Then
        If AddIns(ADDIN_NAME).Installed = True Then
            AddIns(ADDIN_NAME).Installed = False
        End If
    End If
    
    ' アドイン規定のディレクトリに保存（拡張子：xlsm→xlam）
    savePath = Application.UserLibraryPath & Replace(ThisWorkbook.Name, ".xlsm", ".xlam")
    
    ' アドイン追加
    Application.DisplayAlerts = False
    ThisWorkbook.SaveAs savePath, XlFileFormat.xlOpenXMLAddIn
    Application.DisplayAlerts = False
    
    ' 完了メッセージ表示
    If ThisWorkbook.Saved = True Then
        MsgBox "アドインを追加しました。Excelを再起動してアドインを有効にしてください。", vbInformation
    End If
    
End Sub

' アドイン有効
Public Sub AddinEnabled()
    ' アドイン有無チェック
    If IsExistAddin() Then
        AddIns(ADDIN_NAME).Installed = True
    End If
 
 End Sub

' アドイン無効
Public Sub AddinUnEnabled()
    ' アドイン有無チェック
    If IsExistAddin() Then
        AddIns(ADDIN_NAME).Installed = False
    End If

End Sub

' アドイン有無チェック
Public Function IsExistAddin() As Boolean

    Dim addin As addin
    For Each addin In AddIns
        If addin.Name = ADDIN_FILE_NAME Then
            IsExistAddin = True
            Exit Function
        End If
    Next
    
    IsExistAddin = False

End Function

' 右クリックメニューを追加
Public Sub AddMenuRight()

    ' 右クリックメニューを削除
    Call DeleteMenuRight
    
    '一番上のメニューから下がグループの始まりと設定する
    Application.CommandBars("Cell").Controls(1).BeginGroup = True
    
    ' 右クリックメニューを追加
    'With Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup, Before:=1)    ' 先頭に追加
    With Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup)    ' 末尾に追加
        .Caption = MENU_RIGHT_CLICK
        .BeginGroup = True
        With .Controls.Add
            .Caption = "Excelファイルを開く"
            .OnAction = "'OpenExcel """ & EXCEL_FILE & """'"
            .BeginGroup = True
            .FaceId = 1
        End With
        With .Controls.Add
            .Caption = "PDFファイルを開く"
            .OnAction = "'OpenPDF """ & PDF_FILE & """'"
            .BeginGroup = True
            .FaceId = 1
        End With
    End With
    
End Sub

' 右クリックメニューを削除
Public Sub DeleteMenuRight()
    
    Dim cmd
    For Each cmd In Application.CommandBars("Cell").Controls
        If TypeName(cmd) = "CommandBarPopup" Then
            If cmd.Caption = MENU_RIGHT_CLICK Then
                cmd.Delete
            End If
        End If
    Next
    
End Sub

' Excelファイルを開く
Public Sub OpenExcel(pExcelFile As String)

    Workbooks.Open pExcelFile
    
End Sub

' PDFファイルを開く
Public Sub OpenPDF(pWordFile As String)

    CreateObject("Shell.Application").ShellExecute pWordFile
    
End Sub
```

# 4. 動作確認
* Initを実行する
* SaveAddinを実行する
* Excelを再起動する
* AddinEnabledを実行する
* AddMenuRightを実行する

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/2852081/80c1e4f6-10f4-f6a6-54e7-83cfc3f98cda.png)

# 5. 参考文献

http://officetanaka.net/excel/vba/tips/tips30.htm

http://officetanaka.net/excel/vba/file/file01.htm