【VBA】右クリックメニュー追加

筆箱にカンニングペーパーを入れる係のみすくです。こんにちは。
VBA関連だけまとめたブログもあります。
筆箱VBA

なんだかやる気が出なくて、中途半端なんだけれど、
取りあえずやりたいことはできる。
やる気が出たら、もっとエレガントな感じに修正したい。

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

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 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

コメントを残す コメントをキャンセル

コメントを残すコメントをキャンセル