Per vializzare il menu usare una chiamata nell'evento Worksheet_BeforeRightClick (vedi esempio).
Nell'esempio viene aggiunta solo una voce di menu, ma posiamo aggiungere altre voci di menu o altri menu.
Puoi scegliere il codice FaceID da questa pagina o altre simili in rete.
ENG: You can add contextual menu by adding a call to PreparaMenuContestuale into Workbook_Open event.
You can display context menu by calling it into Worksheet_BeforeRightClick event (see below example).
In this example only one menu item are added, but you can add more items and more menus.
You can view FaceID code in this page or others similar in the net. FaceID
'
' Add Command Bar Items
'
Sub PreparaMenuContestuale(Optional dummy As Boolean = False)
Dim ContextMenu As CommandBarPopup
Dim sName As String
Dim sAction As String
Dim sTag As String
Dim i As Long
sName = "contextMenuName"
sAction = "'" & ThisWorkbook.Name & "'!PLG_" ' Base Name of the code called by menu PLG_ are sample
sTag = "Tag_PLG" ' Tag for alla items in this menu
DeleteFromCommandBar sName ' Removing if already present
With Application.CommandBars.Add( _
Name:=sName, Position:=msoBarPopup, _
MenuBar:=False, Temporary:=True) ' Add new command bar menu
With .Controls.Add(Type:=msoControlButton) ' Add first munu item
.Caption = "Modifica Articolo" ' What you see in menu
.TAG = sTag ' Used for searching
.OnAction = sAction & "ModificaArticolo" ' Name of procedure called
.FaceId = 2059 ' ID of image used in menu (optional)
.DescriptionText = _
"Modifica le proprietà dell'articolo " ' Hint for this menu item
.TooltipText = .DescriptionText ' What you see in tootip text Ballon
End With
End With
End Sub
'
' Remove command Bar specified by name
'
Sub DeleteFromCommandBar(sCommandBarName As String)
On Error Resume Next
With Application.CommandBars(sCommandBarName)
If Error.Number = 0 Then
.Delete
End If
End With
Error.Clear
On Error GoTo 0
End Sub
'
' Remove alla the item with specidied tag from commandBarMenu specified by name
' if tag is empty rempve all items
'
Sub DeleteFromCommandBarTAG(sCommandBarName As String, Optional sTag As String = "")
Dim ContextMenu As CommandBar
Dim ctrl As CommandBarControl
On Error Resume Next
' Define pointer to menu
Set ContextMenu = Application.CommandBars(sCommandBarName)
' Loop for all menu items
For Each ctrl In ContextMenu.Controls
If ctrl.Tag = sTag Or sTag = "" Then
' Delete when TAG is equal os sTag is empty
ctrl.Delete
End If
Next ctrl
On Error GoTo 0
End Sub
'
' Place this code into worksheet declaration
'
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Row = 3 Then
If Target.Column < 5 then
Cancel = True 'Prevent executing of normal Double Click event
Application.CommandBars("contextMenuName").ShowPopup 'Show Menu
End If
End If
End Sub
Nessun commento:
Posta un commento