sabato 19 marzo 2016

Excel VBA Context menu

ITA: Per aggiungere un menu contestuale, richiamare PreparamenuContestuale nell'evento evento Workbook_Open.
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