EXCEL-VBA コンテキストメニュー 右クリック追加 


MicrosoftのContext関連library

↓作ったもの↓
'#コンテキストメニューのみのモジュール

'必要な設定 'コンテキスト(右クリック)メニュー内のユーザーメニューまとめ用TAG
Const My_Contname = "User_Name_CK"

Dim ContextMenu As CommandBar
Dim MySubMenu As CommandBarControl
Dim ctrl As CommandBarControl

'追加
Sub AddToCellMenu()

'最初に削除.
Call DeleteFromCellMenu

' CellのコンテキストメニューにSET.
Set ContextMenu = Application.CommandBars("Cell")

'サンプル cellコンテキストメニューに 上書き保存を追加(Save = 3)
' ContextMenu.Controls.Add Type:=msoControlButton, ID:=3, before:=1

Set MySubMenu = ContextMenu.Controls.Add(Type:=msoControlPopup, before:=6)

With MySubMenu
.Caption = "●用Menu"
.Tag = My_Contname

With .Controls.Add(Type:=msoControlButton)
.OnAction = "'" & ThisWorkbook.Name & "'!" & "アクション名"
.FaceId = 498 '適当-Faceidループボタンで調べたのをつけた
.Caption = "選択範囲を変換(&対応キー)"
.Tag = My_Contname
.TooltipText = "説明"
End With

' Treeで追加 一応これで ポップアップの中にメニュー入るが、使い方okなのかは未確認
With .Controls.Add(Type:=msoControlPopup)
.Caption = "メール_メニュー"
.BeginGroup = True
.Tag = My_Contname

With .Controls.Add(Type:=msoControlButton)
.OnAction = "'" & ThisWorkbook.Name & "'!" & "OPEN_api"
.FaceId = 24
.Caption = "宛名件名メールに"
.Tag = My_Contname
End With

With .Controls.Add(Type:=msoControlButton)
.OnAction = "'" & ThisWorkbook.Name & "'!" & "send_ML"
.FaceId = 322
.Caption = "本文追加したメール"
.Tag = My_Contname
End With
’MAIL関係 添付ファイル attも設定できるらしいがまた今度。
End With

With .Controls.Add(Type:=msoControlButton)
.OnAction = "'" & ThisWorkbook.Name & "'!" & "startTprint_F"
.FaceId = 635
.Caption = "テプラ出力()"
.BeginGroup = True
.Tag = My_Contname
End With

With .Controls.Add(Type:=msoControlButton)
.OnAction = "'" & ThisWorkbook.Name & "'!" & "FormulasView"
.FaceId = 308
.Caption = "数式表示トグル"
.Tag = My_Contname
End With

With .Controls.Add(Type:=msoControlButton)
.OnAction = "'" & ThisWorkbook.Name & "'!" & "STSBar"
.FaceId = 866
.Caption = "ステータスバー戻す"
.Tag = My_Contname
End With

End With


' Add a separator to the Cell context menu.
ContextMenu.Controls(6).BeginGroup = True

End Sub

Sub DeleteFromCellMenu()

' ユーザー設定コンテキストメニューを消す
' Set ContextMenu to the Cell context menu.
Set ContextMenu = Application.CommandBars("Cell")

' Delete the custom controls with the Tag : My_Cell_Control_Tag.
For Each ctrl In ContextMenu.Controls
If ctrl.Tag = My_Contname Then
ctrl.Delete
End If

Next ctrl

End Sub


Sub PropFromCellMenu()
'よけいなコンテキストメニューできた時に削除するこード

' Set ContextMenu to the Cell context menu.
Set ContextMenu = Application.CommandBars("Cell")

' Delete the custom controls with the Tag : My_Cell_Control_Tag.
For Each ctrl In ContextMenu.Controls
Debug.Print ctrl.Caption
If ctrl.Caption = "" Then ctrl.Delete

Next ctrl

End Sub

ブログ気持玉

クリックして気持ちを伝えよう!

ログインしてクリックすれば、自分のブログへのリンクが付きます。

→ログインへ

なるほど(納得、参考になった、ヘー)
驚いた
面白い
ナイス
ガッツ(がんばれ!)
かわいい

気持玉数 : 0

この記事へのコメント

この記事へのトラックバック