Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : Excel 2010)
個人用マクロブックでワークシートイベントのBeforeRightClickのような動きをさせるには?
投稿日時: 20/08/27 18:02:42
投稿者: あのん345

いつも勉強させていただいています。
 
個人用マクロブック上に下記のコードで右クリックメニューに項目を追加しています。
内容としては
『 値コピー(必須) + 行列入れ替え 有・無 + 千 又は 百万 での除算 』の5パターンです。
 
現在追加した項目は右クリックメニュー上に常時表示していますが
右クリックしたらコピーモードの時のみ追加した項目を表示させたいと思い
ワークシートイベントのBeforeRightClickのような動きを
個人用マクロブック上でやることは可能ですか?
 
可能であれば参考になるサイトやヒント等教えていただけるとありがたいです。
宜しくお願いします。
 
 
Sub 右クリックメニュー追加()
 
    Application.CommandBars("Cell").Reset
         
    With Application.CommandBars("Cell").Controls.Add(Before:=3, Type:=msoControlPopup)
     
        .Caption = "値コピー"
         
        'ここから下はサブメニューとして追加
            With .Controls.Add
                .Caption = "縦横入れ替えのみ"
                .OnAction = "'値コピーと入れ替え 1,True'"
            End With
         
            With .Controls.Add
                .Caption = "縦横入れ替えて÷1,000"
                .OnAction = "'値コピーと入れ替え 1000,True'"
            End With
         
            With .Controls.Add
                .Caption = "縦横入れ替えて÷1,000,000"
                .OnAction = "'値コピーと入れ替え 1000000,True'"
            End With
             
            With .Controls.Add
                .Caption = "÷1,000"
                .OnAction = "'値コピーと入れ替え 1000,False'"
            End With
         
            With .Controls.Add
                .Caption = "÷1,000,000"
                .OnAction = "'値コピーと入れ替え 1000000,False'"
            End With
         
    End With
     
End Sub
 
Sub 値コピーと入れ替え(ByVal div As Long, flg As Boolean)
 
If Application.CutCopyMode <> xlCopy Then Exit Sub
     
    Application.ScreenUpdating = False
        Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=flg
        If div <> 1 Then 割り算 div, Selection.Value '『縦横入れ替えのみ』以外は『割り算』へ
    Application.ScreenUpdating = True
                 
End Sub
         
Private Sub 割り算(ByVal div As Long, v As Variant)
         
Dim i As Long, j As Long, tmp As Variant
 
    If IsArray(v) = False Then
        tmp = v
        ReDim v(0, 0)
        v(0, 0) = tmp
    End If
     
        For i = LBound(v, 1) To UBound(v, 1)
            For j = LBound(v, 2) To UBound(v, 2)
                If IsNumeric(v(i, j)) = True And v(i, j) <> "" Then v(i, j) = v(i, j) / div
            Next j
        Next i
     
    Selection.Value = v
 
End Sub

回答
投稿日時: 20/08/27 22:31:24
投稿者: よろずや

個人用マクロブックの ThisWorkbook のモジュールに下記コードを書けばよろしいかと。
 

Private WithEvents App      As Excel.Application

Private Sub App_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    右クリックメニュー追加
End Sub

回答
投稿日時: 20/08/28 10:02:38
投稿者: よろずや

記載もれがあったので再掲
 
個人用マクロブックの ThisWorkbook のモジュールに下記コードを書く

Private WithEvents App As Excel.Application

Private Sub App_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    右クリックメニュー追加
End Sub

Private Sub Workbook_Open()
    Set App = Excel.Application
End Sub

投稿日時: 20/08/28 12:04:51
投稿者: あのん345

よろずや 様
 
ありがとうございます!!!
教えていただいたコードを参考に思った通りに動くことが出来ました!!!
 
こういう書き方をすれば出来るんですね
勉強になります
 
繰り返しになりますが再度お礼を。。。
教えていただきありがとうございました!!!