Lav din egen popup-menu i Excel med VBA
Med VBA kan du nemt lave en popup-menu (også kaldet genvejsmenu), som kommer frem ved højreklik og erstatter Excels indbyggede standardmenu for klik på højre museknap.
Hvert menupunkt kan kalde en af dine makroer eller en standardfunktion i Excel, og et menupunkt kan skjules, vises, deaktiveres eller aktiveres runtime alt efter omstændighederne. Det vil sige, at en variabels værdi kan afgøre, om et menupunkt fx skal skjules eller deaktiveres.
Det kræver kun to makroer at få popup-menuen frem. En, hvor man strikker menuen sammen, og en der automatisk kalder menuen, når der højreklikkes. Det er dog praktisk at lave menuen automatisk, når regnearket åbnes. Se herom senere.
For at afprøve eksemplet nedenunder skal du kopiere makroerne "CreateShortcut" og "Dummy1" til "Dummy7" til et standardmodul i VBA. Du kan bare markere med musen, kopiere (CTRL+C) og sætte ind med CTRL+V. Hvis du bruger en lille skærm, kan nogle af kodelinjerne være tekstombrudte, men linjeskiftene er OK, når du sætter det kopierede ind.
Makroen "Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)" skal indsættes i kodearket for det/de faneblade, hvor du ønsker at bruge din egen popup-menu.
I billedet til højre er kodearket for Sheet1 (første faneblad) markeret. Heri kan man lægge netop den slags kode, som aktiveres automatisk ved bestemte handlinger/events på dette faneblad.
Alternativt kan du downloade et regneark (Excel 2003) med demo-menuen. Regnearket er zip-komprimeret og pakkes ud ved at højreklikke på filen og gøre, hvad Windows foreslår for at pakke den ud.
Hvis du ønsker, at din popup-menue skal fungere automatisk, når du åbner regnearket, kan du lave en Auto_Open-procedure (makro), som ser således ud:
Sub Auto_Open()
CreateShortcut
End Sub
Proceduren kører automatisk, når regnearket åbnes. Og nu til sagen - først den procedure, som laver menuen, og derefter de 7 demo-makroer, som bare popper op med en besked. Til slut følger den makro, som skal ligge i fanebladets kodeark.
Sub CreateShortcut()
Dim myBar As CommandBar
Dim myItem As CommandBarControl
On Error Resume Next
CommandBars("MyShortcut").Delete
On Error GoTo ErrorHandle
Set myBar = CommandBars.Add _
(Name:="MyShortcut", Position:=msoBarPopup, Temporary:=True)
Set myItem = myBar.Controls.Add(Type:=msoControlButton)
With myItem
.Caption = "&Menupunkt 1..."
.OnAction = "Dummy1"
.FaceId = 133
End With
Set myItem = myBar.Controls.Add(Type:=msoControlButton)
With myItem
.Caption = "M&enupunkt 2..."
.OnAction = "Dummy2"
.FaceId = 133
End With
Set myItem = myBar.Controls.Add(Type:=msoControlButton)
With myItem
.Caption = "Me&nupunkt 3..."
.OnAction = "Dummy3"
.FaceId = 1848
End With
Set myItem = myBar.Controls.Add(Type:=msoControlButton)
With myItem
.Caption = "Men&upunkt 4..."
.OnAction = "Dummy4"
.FaceId = 387
.BeginGroup = True
End With
Set myItem = myBar.Controls.Add(Type:=msoControlButton)
With myItem
.Caption = "Menu&punkt 5..."
.OnAction = "Dummy5"
.FaceId = 109
End With
Set myItem = myBar.Controls.Add(Type:=msoControlButton)
With myItem
.Caption = "Menupun&kt 6..."
.OnAction = "Dummy6"
.FaceId = 19
End With
Set myItem = myBar.Controls.Add(Type:=msoControlButton)
With myItem
.Caption = "Menupunk&t 7..."
.OnAction = "Dummy7"
.FaceId = 4
End With
Exit Sub
ErrorHandle:
MsgBox Err.Description & vbNewLine & _
"Procedure CreateShortcut.", vbCritical, "Error"
End Sub
Det var første etape. Du kan selvfølgelig lave det antal menupunkter, du ønsker. Nu følger de 7 demo-makroer, som menuen kalder.
Sub Dummy1()
MsgBox "Menupunkt 1"
End Sub
Sub Dummy2()
MsgBox "Menupunkt 2"
End Sub
Sub Dummy3()
MsgBox "Menupunkt 3"
End Sub
Sub Dummy4()
MsgBox "Menupunkt 4"
End Sub
Sub Dummy5()
MsgBox "Menupunkt 5"
End Sub
Sub Dummy6()
MsgBox "Menupunkt 6"
End Sub
Sub Dummy7()
MsgBox "Menupunkt 7"
End Sub
Nu følger den makro, som skal ligge i fanebladets kodeark.
Private Sub Worksheet_BeforeRightClick _
(ByVal Target As Excel.Range, Cancel As Boolean)
Dim rIsect As Range
On Error GoTo ErrorHandle
Set rIsect = Application.Intersect(Range("Area"), Target)
If Not rIsect Is Nothing Then
CommandBars("MyShortcut").ShowPopup
Cancel = True
End If
BeforeExit:
Set rIsect = Nothing
Exit Sub
ErrorHandle:
MsgBox Err.Description
Resume BeforeExit
End Sub
Det var det, nu kan du lave din egen popup-menu, og det er i bund og grund ret enkelt, synes jeg. På denne side kan du få et overblik over alle de små ikoner (FaceID's), som du kan bruge i din menu.
Relaterede sider:
|