VBA 右クリックメニューに文字追加し、列ごとに表示を変えたい

Question

VBA 右クリックメニューに文字追加し、列ごとに表示を変えたい

### 発生している問題・エラーメッセージ
通常メニューの表示がおかしくなってしまう

### 該当のソースコード

```ここに言語を入力
```VBA
Dim cmdBra1 As CommandBarControl, cmdBra2 As CommandBarControl
Dim cmdBra3 As CommandBarControl, cmdBra4 As CommandBarControl
Dim cmdBra5 As CommandBarControl, cmdBra6 As CommandBarControl
Dim cmdBra7 As CommandBarControl, cmdBra8 As CommandBarControl

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

If Not Application.Intersect(Target, Range("A:A")) Is Nothing Then
　 '以下で、新規のメニューを追加
　Set cmdBra1 = Application.CommandBars("Cell").Controls.Add(Before:=1, Type:=msoControlPopup)
　　With cmdBra1
　　　.Caption = "▽野菜▽" 'グループメニュー名
　　End With
　Set cmdBra2 = cmdBra1.Controls.Add()
　　With cmdBra2
　　　.Caption = "胡瓜" 'メニュー表示名
　　　.FaceId = 2
　　　.OnAction = "胡瓜" '実行するマクロ名
　　End With
 Set cmdBra2 = cmdBra1.Controls.Add()
　　With cmdBra2
　　　.Caption = "白菜"
　　　.FaceId = 2
　　　.OnAction = "白菜"
　　End With
 Set cmdBra2 = cmdBra1.Controls.Add()
　　With cmdBra2
　　　.Caption = "キャベツ"
　　　.FaceId = 2
　　　.OnAction = "キャベツ"
　　End With
　 End If

If Not Application.Intersect(Target, Range("B:B")) Is Nothing Then
 Set cmdBra3 = Application.CommandBars("Cell").Controls.Add(Before:=1, Type:=msoControlPopup)
　　With cmdBra3
　　　.Caption = "▽果物▽"
　　End With
 Set cmdBra4 = cmdBra3.Controls.Add()
   With cmdBra4
    .Caption = "苺"
    .FaceId = 2
    .OnAction = "苺"
  End With
 Set cmdBra4 = cmdBra3.Controls.Add()
   With cmdBra4
    .Caption = "リンゴ"
    .FaceId = 2
    .OnAction = "リンゴ"
   End With
 Set cmdBra4 = cmdBra3.Controls.Add()
   With cmdBra4
    .Caption = "バナナ"
    .FaceId = 2
    .OnAction = "バナナ"
  End With
   End If

If Not Application.Intersect(Target, Range("C:C")) Is Nothing Then
 Set cmdBra5 = Application.CommandBars("Cell").Controls.Add(Before:=1, Type:=msoControlPopup)
   With cmdBra5
    .Caption = "▽精肉▽"
   End With
 Set cmdBra6 = cmdBra5.Controls.Add()
   With cmdBra6
    .Caption = "豚肉"
    .FaceId = 2
    .OnAction = "豚肉"
   End With
 Set cmdBra6 = cmdBra5.Controls.Add()
    With cmdBra6
     .Caption = "牛肉"
     .FaceId = 2
     .OnAction = "牛肉"
   End With
 Set cmdBra6 = cmdBra5.Controls.Add()
    With cmdBra6
     .Caption = "鶏肉"
     .FaceId = 2
     .OnAction = "鶏肉"
   End With

 Set cmdBra7 = Application.CommandBars("Cell").Controls.Add(Before:=2, Type:=msoControlPopup)
    With cmdBra7
     .Caption = "▼鮮魚▼"
    End With
 Set cmdBra8 = cmdBra7.Controls.Add()
    With cmdBra8
     .Caption = "鮭"
     .FaceId = 2
     .OnAction = "鮭"
   End With
 Set cmdBra8 = cmdBra7.Controls.Add()
    With cmdBra8
     .Caption = "鯖"
     .FaceId = 2
     .OnAction = "鯖"
   End With
 Set cmdBra8 = cmdBra7.Controls.Add()
   With cmdBra8
    .Caption = "秋刀魚"
    .FaceId = 2
    .OnAction = "秋刀魚"
  End With
    End If

Application.CommandBars("Cell").ShowPopup
Application.CommandBars("Cell").Reset
Cancel = True
End Sub```

Dim cmdBar As CommandBar, cmdBarc1 As CommandBarControl
Dim cmdBarc2 As CommandBarControl

 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
 If Not Application.Intersect(Target, Range("I:I")) Is Nothing Then
  Set cmdBar = Application.CommandBars("Cell")
  Set cmdBarc1 = cmdBar.Controls.Add(Before:=1, Type:=msoControlPopup)
    With cmdBarc1
      .Caption = "▽野菜▽"
    With .Controls.Add
     .Caption = "胡瓜"
     .OnAction = "胡瓜"
   End With
   With .Controls.Add
    .Caption = "白菜"
    .OnAction = "白菜"
   End With
    End IF・・・以下同文``````

上記のVBAだとEnd　Ifが不要とのエラーになり、最初の「野菜」メニューしか表示されません

試したこと

形式選択貼り付けが表示されず、複合表として貼り付けになってしまうのは何故か
検索してみましたが、通常メニューを削除する方法しかみつかりませんでした。
上記コードに、値貼り付け・数式貼り付け等を追加し、実行マクロに書き込んでみましたが
右クリック時に表示も出てきません。

補足情報（FW/ツールのバージョンなど）

Excel 2016を使用しております。

長文で分かりにくく、大変申し訳ありません。
VBA初心者の為、色々な方の構文を流用させて頂きました。間違いだらけかと思いますが、教えて頂けると助かります。
宜しくお願い致します!!

Comments

[sazi]

質問を修正し、コード部分はコード挿入(<code>)の内側になるように記入して下さい。

[hatena19]

コードは、Private Sub の行から End Sub までコピーして貼り付けてください。
貼り付けたコードをすべて選択して、ツールバーの <code> ボタンをクリックしてください。
コードが読みやすくなります。

[hatena19]

すみません。Private Sub の行はありましたね。
コードブロックになっていないと読みづらいので、見逃しました。

[saku88]

<code>ボタンをクリックしました。質問の入力方法が分かってなくて、大変申し訳ございません。
ご指摘有難うございます。また何か駄目な箇所があれば教えて下さい。宜しくお願いします。

[sazi]

コード部分はコード挿入(<code>)の内側になるように

[hatena19]

コード部分を選択してから <code> をクリックするか、
クリックで挿入された「ここに言語を入力」の部分にコードをコピーしてください。

[saku88]

丁寧に教えて頂き、有難うございます。こちらで大丈夫でしょうか??
'''の中に入れれば良いのでしょうか?　本当にすみません。。

[sazi]

```VBA
Dim cmdBra1 As CommandBarControl, cmdBra2 As CommandBarControl
～
End Sub
```
のようにします。

[saku88]

何度も申し訳ありません。有難うございます。
'''の中に入れましたが、改行は必要ないのでしょうか?　1ｽﾍﾟｰｽを入れて続けてコピーした方が良いのでしょうか? 基本部分でご迷惑をお掛けまします

[sazi]

２個目は、まあまあ大丈夫じゃないでしょうか。
１個目も同様に。
改行とかは見栄えの話ですから、プレビュー見ながら調整して下さい。

[sazi]

マークダウンされていないとインデントが無く見辛いのです。
マークダウンされているとインデントは生きていますし、簡単にコピー出来て再現させやすいのです。
回答するかどうかするかどうかの、モチベーションに関わってきますので。

[saku88]

修正遅くなり、申し訳ありません。マークダウンをググって修正してみましたが2個目みたいに色は付けられませんでした。すみません

[saku88]

何とかマークダウン?できたようです。宜しくお願い致します。

[sazi]

１個目はインデントされていないのでしょうか？

[saku88]

すみません。先ほど気づきまして、インデントしました。他に見づらい点があれば言って下さい。
宜しくお願い致します。不慣れなもので申し訳ございません。

Answer 1

コードをコピーして試してみましたが、こちらでも同様の症状が出ました。
対処法はちょっとわかりません。

やりたいことは、入力するときに、リストから選択して入力したいということではないですか。
だとしたら、下記の方法はどうでしょうか。

Excel（エクセル）でリストを作成して一覧からデータ入力する方法｜プルダウン、ドロップダウンリスト | Prau（プラウ）Office学習所

対処法

いろいろ、弄ってみて、対処法が分かりました。
最後の、下記の3行が悪さをしているようです。

Application.CommandBars("Cell").ShowPopup
Application.CommandBars("Cell").Reset
Cancel = True

これを削除して、先頭に、Resetのコードを挿入すれば、通常のメニューがおかしくなることはなくなりました。

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)   
    Application.CommandBars("Cell").Reset

このままだと、別シートへ移動したときに、追加したメニューが残ってしまいますので、DeactivateにResetするようにします。

Private Sub Worksheet_Deactivate()
    Application.CommandBars("Cell").Reset
End Sub

以上です。

Comments

[saku88]

ご回答有難うございます!!　やはりプルダウンが良いのかもしれません。
質問にのせたVBA　リストから選択して表示した後1回目は、形式選択貼り付け表示されるのですが、2回目は複合表になってしまうのでその辺がダメなのかもしれません。

[saku88]

hatena19さん 色々調べて頂き、有難うございました。流用したvbaが一旦通常メニューを削除しており、その部分を消してしまったのが悪かったのかもしれません。
こんなに早く、回答して頂けるなんて感謝の念しかありません(>_<)
仕事の関係で、お礼が遅くなり申し訳ないです。また 何かありましたら宜しくお願い致します(T-T)

[saku88]

hatena19さん 　もう見ていないかもしれませんが、再度お礼を言わせて下さい。教えて頂いたコード完璧です!!　やりたい事がすべてかないました。
改めまして、有難うございます。また色々と教えて下さい。
宜しくお願い致します。