Gå til hovedindhold

Hvordan køres flere makroer fra højreklikmenuen i Excel?

doc højreklik makroer 5

Hvis der er flere vba-makroer i din projektmappe, skal du åbne VBA-vinduet og derefter vælge makroen, når du skal køre koden. I denne artikel vil jeg gerne tale om, hvordan man kører makroer fra højreklikmenuen for at gøre dit arbejde mere effektivt som det viste skærmbillede til venstre.

Kør flere makroer fra højreklikmenuen med VBA-koder


Kør flere makroer fra højreklikmenuen med VBA-koder

For at køre makrokoderne i en projektmappe fra højreklikmenuen kan følgende trin hjælpe dig, gør venligst som dette:

1. Hul ned i Alt + F11 nøgler til at åbne Microsoft Visual Basic til applikationer vindue.

2. Dobbeltklik derefter ThisWorkbook til venstre Projekt ruden, og kopier og indsæt derefter nedenstående VBA-kode i det tomme modul.

Private Sub Workbook_Open()
Run "LoadMacro"
End Sub
Private Sub Workbook_Activate()
Run "LoadMacro"
End Sub
Private Sub Workbook_Deactivate()
Run "ClearMacro"
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Run "ClearMacro"
ThisWorkbook.Save
End Sub

doc højreklik makroer 1

3. Stadig i Microsoft Visual Basic til applikationer vindue, klik venligst indsatte > Moduler, og indsæt følgende kode i dette modul.

Private Sub LoadMacro()
Dim xArrMenu As Variant
Dim xStrLine, xSreBtnName As String
Dim xObjCBCF, xObjCntrAll As CommandBarControl
Dim xObjCBCs As CommandBars
Dim xObjCBBtn As CommandBarButton
Dim xIntLine, xFNum As Integer
Dim xObjComponent As Object
Run "ClearMacro"
Set xObjCBCF = Application.CommandBars("Cell").Controls.Add(msoControlPopup, before:=1)
xObjCBCF.Caption = " Run Macro "
xObjCBCF.BeginGroup = False
For Each xObjComponent In ActiveWorkbook.VBProject.VBComponents
    If xObjComponent.Type = 1 Then
        For xIntLine = 1 To xObjComponent.CodeModule.CountOfLines
        xStrLine = xObjComponent.CodeModule.Lines(xIntLine, 1)
        xStrLine = Trim(xStrLine)
            If (InStr(xStrLine, "()") > 0) And (Left(xStrLine, 11) = "Private Sub" Or Left(xStrLine, 3) = "Sub") Then
            xSreBtnName = ""
            If "Private Sub" = Left(xStrLine, 11) Then
                xSreBtnName = Trim(Mid(xStrLine, 12, InStr(xStrLine, "()") - 12))
            ElseIf "Sub" = Left(xStrLine, 3) Then
               xSreBtnName = Trim(Mid(xStrLine, 4, InStr(xStrLine, "()") - 4))
            End If
            If xSreBtnName <> "" And xSreBtnName <> "RightClickReset" And xSreBtnName <> "LoadMacro" And xSreBtnName <> "ActionMacro" Then
                Set xObjCBBtn = xObjCBCF.Controls.Add
                With xObjCBBtn
                    .FaceId = 186
                    .Style = msoButtonIconAndCaption
                    .Caption = xSreBtnName
                    .OnAction = "ActionMacro"
                End With
            End If
            End If
        Next xIntLine
    End If
Next xObjComponent
End Sub
Private Sub ClearMacro()
On Error Resume Next
CommandBars("Cell").Controls(" Run Macro ").Delete
Err.Clear
CommandBars("Cell").Reset
End Sub
Private Sub ActionMacro()
On Error GoTo Err1
With Application
Run .CommandBars("Cell").Controls(1).Controls(.Caller(1)).Caption
End With
Exit Sub
Err1:
    MsgBox "Invalid"
End Sub

doc højreklik makroer 2

4. Når du har indsat koderne, skal du klikke på Værktøjer > ReferencerOg en Referencer-VBAProject dialogboksen vises, og kontroller derefter Microsoft Visual Basic til applikationsudvidelse 5.3 valgmulighed i Tilgængelige referencer listefelt, se skærmbillede:

doc højreklik makroer 3

5. Klik derefter på OK for at afslutte dialogen skal du nu gemme denne projektmappe som Excel-makroaktiveret projektmappe format, se skærmbillede:

doc højreklik makroer 4

6. Endelig skal du genstarte projektmappen for at få kodenes effekt, og når du højreklikker på en celle, a Kør makro valgmulighed indsættes i højreklikmenuen, og alle makroer i din projektmappe vises i undermenuen som følgende skærmbillede:

doc højreklik makroer 5

7. Derefter kan du køre koden bare ved at klikke på den.


Comments (0)
No ratings yet. Be the first to rate!
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations