开发者

show custom toolbar only with certain xls-file

开发者 https://www.devze.com 2023-03-14 15:12 出处:网络
i have a macro (Makro1) that is assigned to a button in a custom toolbar (Custom1) with caption \"Schutzstatus\". i want the toolbar only to be loaded with this very xls-file.

i have a macro (Makro1) that is assigned to a button in a custom toolbar (Custom1) with caption "Schutzstatus". i want the toolbar only to be loaded with this very xls-file.

can someone help me out with the code?

i managed t开发者_开发技巧o customize the tooltip:

Application.CommandBars("Custom1").Controls(1).TooltipText = "Abfrage des Schutzstatus der Arten im Zwischenspeicher"

but i fail in creating the whole thing by vba..

thanks in advance, kay


You don't actually need to (re)create the whole toolbar on loading your XLS, but you need to display/hide it during certain navigations

1 create the toolbar

2 attach it to your XLS (view / toolbars / customize .... / attach)

3 create event procedures to show/hide your toolbar; unless you want to have a specific behaviour for different sheets, the following should be enough to care for all navigation:

Private Sub Workbook_Activate()
    ' show toolbar
    Application.CommandBars("CoolBar").Visible = True
    Application.CommandBars("CoolBar").Controls(1).TooltipText = "C'mon squeeze me"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ' drop toolbar
    Application.CommandBars("CoolBar").Delete
End Sub

Private Sub Workbook_Deactivate()
' see if we have a toolbar (it might have been already deleted by "Workbook_BeforeClose"
' if yes - hide it
Dim Idx As Integer

    For Idx = 1 To Application.CommandBars.Count
        If Application.CommandBars(Idx).Name = "CoolBar" Then
            Application.CommandBars("CoolBar").Visible = False
        End If
    Next Idx
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
' display toolbar
    Application.CommandBars("CoolBar").Visible = True
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    Application.CommandBars("CoolBar").Visible = False
End Sub

Place all in the "ThisWorkbook" object - so they fire on all sheets.

4 After saving the toolbar with the XLS and testing, close the XLS - the toolbar will be still present in your application object - and delete the toolbar from there. Don't panic, it's coming back when you re-open your XLS file.

Hope this helps Tschüss MikeD


Actually the answer was close but didn't work for me. That .Delete does delete the command bar completely as confirmed by Kay in his last comment. You basically had to recreate but bar and button again when the workbook is opened. Below is the improved code:

Private Sub Workbook_Activate()
    ' show toolbar
    Dim SortBar As CommandBar
    Dim BarControl As CommandBarControl

    Set SortBar = FindCommandBar("SortBar")

    If SortBar Is Nothing Then
        Set SortBar = Application.CommandBars.Add("SortBar")

        Set BarControl = SortBar.Controls.Add
        BarControl.OnAction = "Your_Macro_Name"
        BarControl.Caption = "Text for your button"
        BarControl.Style = msoButtonCaption
    End If
    SortBar.Visible = True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ' drop toolbar
    Application.CommandBars("SortBar").Delete
End Sub

Private Sub Workbook_Deactivate()
' see if we have a toolbar (it might have been already deleted by "Workbook_BeforeClose"
' if yes - hide it
    Dim SortBar As CommandBar
    Set SortBar = FindCommandBar("SortBar")
    If Not SortBar Is Nothing Then
        SortBar.Visible = False
    End If
End Sub

Private Function FindCommandBar(Name As String) As CommandBar
Dim Idx As Integer
    For Idx = 1 To Application.CommandBars.Count
        Set FindCommandBar = Application.CommandBars(Idx)
        If FindCommandBar.Name = Name Then
             Exit Function
        End If
    Next Idx
    Set FindCommandBar = Nothing
End Function

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
' display toolbar
    Application.CommandBars("SortBar").Visible = True
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    Application.CommandBars("SortBar").Visible = False
End Sub
0

精彩评论

暂无评论...
验证码 换一张
取 消

关注公众号