Jak vytvořit přizpůsobené nabídky v listu aplikace Excel pomocí VBA

Pás karet aplikace Excel lze upravit tak, aby vyhovoval konkrétní úloze. Toto cvičení vytváří nové nabídky, které odkazují uživatele na konkrétní listy relevantní pro jejich úkol.

V tomto článku si představíme, jak vytvořit přizpůsobené nabídky v listu aplikace Excel, například takto:

Tento článek předpokládá, že čtenář má zobrazený pás karet pro vývojáře a je obeznámen s editorem VBA. Pokud ne, prosím Google „Excel Developer tab“ nebo „Excel Code Window“.

Cvičebnice

Sešit, který se má použít, má několik listů. Doporučujeme použít ukázkový zde nalezený. Vypadá to takhle.

První čtyři listy jsou nefunkční a používají se v tomto cvičení pouze pro účely navigace.

Pátý list bude obsahovat přizpůsobenou strukturu nabídky pro tento sešit. V současné době by měl být prázdný, kromě tlačítka Test.

Přidejte strukturu nabídky

Zkopírujte následující blok textu do buňky A1 listu „MenuSheet“.

Úroveň, Titulek, Poloha / Makro, Oddělovač

1, & Uživatelské nástroje, 10

2, Zobrazit panel, Vybrat panel

2, Přidat nový,, PRAVDA

3, Klient, SelectClient

3, Location, SelectLocation

3, manažer, SelectManager

2, Zavřít, ZavřítSoubor

Naformátujte strukturu nabídky

Tato data CSV končí ve sloupci A. Chcete-li je formátovat do jednotlivých buněk aplikace Excel, vyberte sloupec A a použijte 'Text to columns' v Karta Data. Oddělovač by byl „čárka“.

Výše uvedené, jakmile přidáme příslušný kód, nám poskytne strukturu nabídky na úrovni vlevo.

První úroveň je v tomto cvičení libovolně umístěna jako desátá položka na panelu nabídek, jak uvidíte při zobrazení celé šířky sešitu.

Vytváření a ničení nabídek

Protože chceme pouze nové nabídky pro tento konkrétní sešit, vytvoříme a zničíme je při otevření a zavření sešitu.

Následující kód je začátek. Bude spuštěn při otevření nebo zavření sešitu. Zkopírujte jej do modulu ve vašem sešitu.

Přiřaďte tlačítko Test na MenuSheet k Auto_Open.

Option Explicit

Sub auto_Open()
    Call DeleteMenu
    Call CreateMenu
 End Sub
 
Sub auto_Close()
    Call DeleteMenu
End Sub

Níže podrobněji prozkoumáme naši strukturu nabídky.

Žádné makro není spuštěno Vytvořit zeď protože nemá jinou funkci než nadřazené podřízené nabídky.

Tento druh struktury nabídky se snadno udržuje. Jednoduše přidejte nové položky pomocí jejich maker, přičemž si uvědomte úroveň nabídky.

Kodex

Připojte k modulu následující kód VBA. Tím se prozkoumá „MenuSheet“ a vytvoří se přizpůsobené menu.

Sub CreateMenu()
'   Called from Auto_Open. 'NOTE: There is no error handling in this subroutine
    Dim MenuSheet As Worksheet
    Dim MenuObject As CommandBarPopup

    Dim MenuItem As Object
    Dim SubMenuItem As CommandBarButton
    Dim sRow As Integer
    Dim MenuLevel, NextLevel, PositionOrMacro, Caption, Divider

    Set MenuSheet = ThisWorkbook.Sheets("MenuSheet")
    Call DeleteMenu

    sRow = 2 '   start row
    
'   Add menus using the structure as per the MenuSheet
    Range("A" & sRow).Select
    Do While ActiveCell > "" '****************
        With MenuSheet
            MenuLevel = .Cells(sRow, 1)
            Caption = .Cells(sRow, 2)
            PositionOrMacro = .Cells(sRow, 3)
            Divider = .Cells(sRow, 4)
            NextLevel = .Cells(sRow + 1, 1)
        End With
        
        Select Case MenuLevel
            Case 1 ' Add the top-level menu to the Worksheet CommandBar
                Set MenuObject = Application.CommandBars(1). _
                    Controls.Add(Type:=msoControlPopup, _
                    Before:=PositionOrMacro, _
                    Temporary:=True)
                MenuObject.Caption = Caption
            Case 2 ' A Menu Item
                If NextLevel = 3 Then
                    Set MenuItem = MenuObject.Controls.Add(Type:=msoControlPopup)
                Else
                    Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
                    MenuItem.OnAction = PositionOrMacro
                End If
                MenuItem.Caption = Caption
                If Divider Then MenuItem.BeginGroup = True
            Case 3 ' A SubMenu Item
                Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton)
                SubMenuItem.Caption = Caption
                SubMenuItem.OnAction = PositionOrMacro
                
                If Divider Then SubMenuItem.BeginGroup = True
        End Select
        sRow = sRow + 1
        Range("A" & sRow).Select '***************************************
    Loop
    Sheets("Dashboard").Activate
End Sub

Sub DeleteMenu()
'   This sub will be executed when the workbook is closing
    Dim MenuSheet As Worksheet
    Dim sRow As Integer
    Dim Caption As String
    
    On Error Resume Next
    Set MenuSheet = ThisWorkbook.Sheets("MenuSheet")
    sRow = 2
    Range("A" & sRow).Select
    Do While ActiveCell > ""
        If MenuSheet.Cells(sRow, 1) = 1 Then
            Caption = MenuSheet.Cells(sRow, 2)
            Application.CommandBars(1).Controls(Caption).Delete
        End If
        sRow = sRow + 1
        Range("A" & sRow).Select
    Loop
   
    On Error GoTo 0
End Sub

Sub SelectDashboard()
    Sheets("Dashboard").Activate
End Sub
Sub SelectClient()
    Sheets("Client").Activate
End Sub

Sub SelectLocation()
    Sheets("Location").Activate
End Sub

Sub SelectManager()
    Sheets("Manager").Activate
End Sub

Sub CloseFile()
    MsgBox "Close! (write your own code in the module)"
End Sub

Otestujte kód pomocí tlačítka Test. Nově vytvořené uživatelské menu najdete na pozici 10 nabídky v části Doplňky.

Obnova aplikace Excel

Excel je občas nestabilní a při otevření se zhroutí a poškodí zdrojový soubor. Pokud se soubor nepodaří obnovit, je užitečné mít k dispozici nástroj na opravu Excel poškození jinak bude veškerá nezálohovaná práce ztracena.

Úvod autora:

Felix Hooker je odborník na obnovu dat v oboru DataNumen, Inc., která je světovým lídrem v oblasti technologií pro obnovu dat, včetně opravit rar a SQL softwarové produkty pro obnovu. Pro více informací navštivte www.datanumen.com