なんだかやる気が出なくて、中途半端なんだけれど、
取りあえずやりたいことはできる。
やる気が出たら、もっとエレガントな感じに修正したい。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 |
Option Explicit Public Sub AddMenuMain() '標準状態にリセット Application.CommandBars("Cell").Reset Call AddMenu1 Call AddMenu2 End Sub '--------------------------------------------------------------------------------------------------- '【処 理 名】右クリックメニュー追加 '【処理概要】 '【引 数】なし '【返 却 値】なし '--------------------------------------------------------------------------------------------------- Private Sub AddMenu1() Dim cmdBarCtrl As CommandBarControl Set cmdBarCtrl = Application.CommandBars("Cell").Controls.Add(Type:=msoControlButton, Temporary:=True) With cmdBarCtrl .Caption = "なまえ" .OnAction = "inputName" End With End Sub '--------------------------------------------------------------------------------------------------- '【処 理 名】右クリックメニュー追加(サブメニューあり) '【処理概要】 '【引 数】なし '【返 却 値】なし '--------------------------------------------------------------------------------------------------- Private Sub AddMenu2() Dim cmdBarCtrl As CommandBarControl Set cmdBarCtrl = Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup, Temporary:=True) With cmdBarCtrl .Caption = "めにゅー" With .Controls.Add .Caption = "さぶめにゅー" .OnAction = "inputName" End With End With End Sub Private Sub inputName() Dim rng As Range For Each rng In Selection rng.Value = "みすく" Next rng End Sub Sub Sample2() CommandBars("Cell").Controls("なまえ").Delete End Sub |