Přejít k hlavnímu obsahu

Jak spustit více maker z nabídky pravého tlačítka myši v aplikaci Excel?

Autor: Xiaoyang Naposledy změněno: 2019-03-20
doc makra s pravým kliknutím 5

Pokud je v sešitu více maker vba, měli byste otevřít okno VBA a poté vybrat makro, když potřebujete spustit kód. V tomto článku bych chtěl hovořit o tom, jak spustit makra z nabídky pravého kliknutí, aby byla vaše práce efektivnější, jak je ukázáno na levém snímku obrazovky.

Spusťte více maker z nabídky pravého tlačítka myši s kódy VBA


Spusťte více maker z nabídky pravého tlačítka myši s kódy VBA

Chcete-li spustit kódy maker v sešitu z nabídky pravého kliknutí, mohou vám pomoci následující kroky, postupujte takto:

1. Díra dolů Alt + F11 klávesy pro otevření Microsoft Visual Basic pro aplikace okno.

2. Poté poklepejte Tato pracovní kniha vlevo Projekt panelu a poté zkopírujte a vložte níže uvedený kód VBA do prázdného modulu.

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 makra s pravým kliknutím 1

3. Stále v Microsoft Visual Basic pro aplikace okno, klikněte prosím Vložit > Modula do tohoto modulu vložte následující kód.

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 makra s pravým kliknutím 2

4. Po vložení kódů klikněte na Tools > Reference, A Reference-VBAProject Zobrazí se dialogové okno a poté zkontrolujte Microsoft Visual Basic pro rozšiřitelnost aplikací 5.3 možnost v Dostupné reference seznam, viz screenshot:

doc makra s pravým kliknutím 3

5. Pak klikněte na tlačítko OK Chcete-li dialog zavřít, měli byste tento sešit uložit jako Sešit se zvýšeným makra Excel formát, viz screenshot:

doc makra s pravým kliknutím 4

6. Nakonec restartujte sešit, abyste získali efekt kódů, a nyní, když kliknete pravým tlačítkem na buňku, a Spustit makro možnost je vložena do nabídky s pravým kliknutím a všechna makra v sešitu jsou uvedena v podnabídce jako následující snímek obrazovky:

doc makra s pravým kliknutím 5

7. Potom můžete spustit kód pouhým kliknutím na něj.


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