Skapa verktygsfält i cellområde

Skapa verktygsfält för specifika cellområden

I detta exempel visas hur vi relativt enkelt kan skapa ett s k pop-up verktygsfält för ett begränsat cellområde.

Antag att vi har ett cellområde där vi vill utföra vissa kommandon. Dessa kommandon vill vi nå när vi högerklickar inom cellområdet.

Följande kod placeras i "ThisWorkbook- / DennaArbetsbok"-modul.

Option Explicit

Private Sub Workbook_Open()
Call Skapa_Verktygsfält
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.CommandBars("XL-PopUp").Delete
End Sub

Här skapas verktygsfältet som ska kopplas till cellområdet.

Option Explicit
Sub Skapa_Verktygsfält()

'Felhanteringsrutin
On Error Resume Next
Application.CommandBars("XL-PopUp").Delete
On Error GoTo 0

'Här styrs verktygsfältet tillhörighet genom att sätta egenskapen
'Position till msoBarPopup
With Application.CommandBars.Add(Name:="XL-PopUp", Position:=msoBarPopup)

        With .Controls.Add(Type:=msoControlButton)
               .Caption = "Test"
               .OnAction = "Procedurnamn som ska köras"
               .FaceId = 343
        End With

       With .Controls.Add(Type:=msoControlPopup)
                .Caption = "Analys"
                With .Controls.Add(Type:=msoControlButton)
                       .Caption = "Vertikal analys"
                       .FaceId = 70
                       .OnAction = "Analys_Vertikalt"
                End With
                With .Controls.Add(Type:=msoControlButton)
                       .Caption = "Horisontel analys"
                       .FaceId = 71
                       .OnAction = "Analys_Horisontellt"
                End With
       End With
End With
End Sub

Slutligen knyts verktygsfältet till det önskade cellområde, vilket sker i den önskade arbetsbladmodulen.

Option Explicit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, _
Cancel As Boolean)

'Här undersöks huruvida aktiv cell är inom cellområdet eller inte. Om inte
'så visas den vanliga menyn.
If Not Intersect(Range("CellOmråde"), Target) Is Nothing Then
         Application.CommandBars("XL-PopUp").ShowPopup
         Cancel = True
End If

End Sub

Resultatet av ovanstående procedurer och vid högerklick inom cellområdet blir följaktligen: