【Excel VBA】セル上の右クリックのメニューに、機能を追加してみた

## ＜はじめに＞
Excelをよく使う職場なのですが、

```
・エクスプローラーでサーバー上のExcel開いて、邪魔だからエクスプローラー閉じたけど
あれ？どこの場所のエクセル開いてるんだっけ？とか
```

```
・フルパスの確認とか、コピーを「ファイル＞情報」から出来るけど、開くの手間だなーとか
```

```
・帳票を見ていて、ちょっと計算があっているか、直ぐに電卓起動したいなーとか
```

とか色々、思うところがあり

エクセル上から、色々ショートカットできないものかと

__ただ、クイック アクセス ツールバーには、もう追加したくない❗__
（もう半分くらい占領されているから）

リボンでもいいけど、なんかスマートじゃない・・・

色々調べていたら、セル上の右クリックのメニューに独自機能を追加できるとのこと。

<br>

＞やりたいこと・・

▼とりあえず、右クリックのメニューに以下を追加してみたい
ファイル情報
├　ファイルパス表示
├　ファイルの保存場所を開く
└　フルパスをコピー

アプリ起動
├　電卓
└　エクスプローラー

▼どのブックでも使いたいので、個人ブックのマクロにて実施する

## ＜やってみた＞

標準モジュールに記載
▼メニューを作る部分

``` vb:[メニュー定義]sub
Sub AddMenu()

    '独自コマンドをリセット
    CommandBars("Cell").Reset
    
    '変数定義
    Dim Newbar As CommandBarControl
    Dim getFileInfo1, getFileInfo2, getFileInfo3 As CommandBarControl
    Dim appMacro1, appMacro2 As CommandBarControl
   
    ' [ファイル情報]
    Set Newbar = CommandBars("Cell").Controls.Add(Type:=msoControlPopup, before:=1)
    With Newbar
        .Caption = "ファイル情報" ' 右クリックの表示名
        .OnAction = "fileInfo" ' 呼び出すSub名
        Set getFileInfo1 = .Controls.Add ' [1] フルパス表示
        Set getFileInfo2 = .Controls.Add ' [2] ファイルの場所を開く
        Set getFileInfo3 = .Controls.Add ' [3] フルパスをコピー
    End With

    ' [アプリ起動]
    Set Newbar = CommandBars("Cell").Controls.Add(Type:=msoControlPopup, before:=2)
    With Newbar
        .Caption = "アプリ起動" ' 右クリックの表示名
        .OnAction = "appExec" ' 呼び出すSub名
        Set appMacro1 = .Controls.Add ' [1] 電卓
        Set appMacro2 = .Controls.Add ' [1] エクスプローラー
    End With
    
    ' 右クリックメニュー項目の「切り取り」の上に区切り線を入れる
    ' 増減させたらControlsの数をずらす必要あり
    CommandBars("Cell").Controls(3).BeginGroup = True
    
End Sub
```


``` vb:[メニュー定義＞ファイル情報]sub
Sub fileInfo()
    
    With CommandBars("Cell").Controls("ファイル情報")
    
        ' [1] フルパス表示
        .Controls(1).Caption = ActiveWorkbook.FullName
        .Controls(1).FaceId = 39
        
        ' [2] ファイルの場所を開く
        .Controls(2).Caption = "ファイルの場所を開く"
        .Controls(2).OnAction = "openExplorer"
        .Controls(2).FaceId = 23
        .Controls(2).TooltipText = "エクスプローラーにて、ファイルの場所を開きます"
        
        ' [3] フルパスをコピー
        .Controls(3).Caption = "フルパスをコピー"
        .Controls(3).OnAction = "pathCopy"
        .Controls(3).FaceId = 19
        .Controls(3).TooltipText = "クリップボードにファイルのフルパスをコピーします"
    End With

End Sub
```

``` vb:[メニュー定義＞アプリ起動]sub
Sub appExec()
    
    With CommandBars("Cell").Controls("アプリ起動")
        '[1] 電卓
        .Controls(1).Caption = "電卓"
        .Controls(1).OnAction = "execCalc"
        .Controls(1).FaceId = 283
        .Controls(1).TooltipText = "電卓を起動します"
        
        '[2] エクスプローラー
        .Controls(2).Caption = "エクスプローラー"
        .Controls(2).OnAction = "execExplr"
        .Controls(2).FaceId = 32
        .Controls(2).TooltipText = "エクスプローラーを起動します"
        
    End With

End Sub
```

▼処理部分（OnAction部分）

``` vb:[ファイル情報]処理sub

Sub openExplorer()
    ' [2] ファイルの場所を開く
    Shell "explorer.exe " & ActiveWorkbook.path, vbNormalFocus

End Sub

Sub pathCopy()
    ' [3] フルパスをコピー
    ' テキストボックス作成してコピーする
    Dim objTxt As Object
    Set objTxt = CreateObject("Forms.TextBox.1")
    With objTxt
        .MultiLine = True
        .Text = ActiveWorkbook.FullName
        .SelStart = 0
        .SelLength = .TextLength
        .Copy
    End With
    Set objTxt = Nothing

End Sub
```

``` vb:[アプリ起動]処理sub
Sub execCalc()
    '[1] 電卓
    Shell "calc.exe", vbNormalFocus
    
End Sub

Sub execExplr()
    '[2] エクスプローラー
    Shell "explorer.exe", vbNormalFocus

End Sub
```





## ＜出来上がり＞

AddMenuを実行するとメニューが追加される。

<br>

▼右クリックしたときのメニュー
(上の方に、ファイル情報とアプリ起動がメニューに追加されている)
![スクリーンショット 2024-06-19 112120.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3693459/f77f660f-9d7b-a000-1316-ac67471bb366.png)


<br>

▼ファイル情報
![スクリーンショット 2024-06-19 112136.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3693459/df3ec6ed-43fe-7ea5-1615-dbf08caae150.png)

<font color="Red">※ </font>シェアポだと「https://[XXXXX].sharepoint.com/site/～/[XXXXX].xlsx」のような、URLで表示され、「ファイルの場所を開く」をするとedgeで開く。

<br>

▼アプリ起動
（各々、起動する）
![スクリーンショット 2024-06-19 112148.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3693459/047c6047-a9b5-f3ce-0eb4-f0b00990eaf5.png)


```
(´・x・).oO◯（ なにげに便利なのでは・・
```

（Microsoft Excel2021 と Microsoft365 v2308で動きました）

<br>

<font color="Red">※ </font>改ページプレビュー状態だと、右クリックが標準に戻ってしまうので注意。


## ＜おわりに＞
・以外と色々追加できそうだなぁ。
・FaceId を探すのが面倒だった。
・beforeを外すと、メニューの下に追加される。
``` vb
Set Newbar = CommandBars("Cell").Controls.Add(Type:=msoControlPopup, before:=1)
↓
Set Newbar = CommandBars("Cell").Controls.Add(Type:=msoControlPopup)
```


## ＜参考＞

以下を参考にさせて頂きました。ありがとうございます。

▼右クリックメニュー
（OnActionに引数付きで呼び出すやり方も載ってました）

https://qiita.com/YoshijiGates/items/89fbf64899e2e886f5e5

▼FaceId を探すのに

http://www7b.biglobe.ne.jp/~whitetiger/ex/ex2002022.html