Question

我有一个宏（Makro1）被分配给自定义工具栏（Custom1）中的按钮，标题为“Schutzstatus”。我希望工具栏只能加载这个非常xls文件。

有人可以帮我解决问题吗？

我设法自定义工具提示：

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

但是我无法通过vba创建整个事情。

提前谢谢，琦

Answer 1

在加载XLS时，您实际上不需要（重新）创建整个工具栏，但是您需要在某些导航期间显示/隐藏它

1创建工具栏

2将它附加到您的XLS（view / toolbars / customize .... / attach）

3创建事件程序以显示/隐藏您的工具栏;除非您希望针对不同的工作表具有特定的行为，否则以下内容应足以关注所有导航：

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

将所有内容放在“ThisWorkbook”对象中 - 这样它们就会在所有工作表上触发。

4使用XLS保存工具栏并进行测试后，关闭XLS - 工具栏仍将出现在应用程序对象中 - 并从那里删除工具栏。不要惊慌，当你重新打开XLS文件时它会回来。

希望这会有所帮助 TschüssMikeD

Answer 2

实际上答案很接近但对我没有用。那个.Delete完全删除了命令栏，正如凯在他的最后评论中所证实的那样。在打开工作簿时，您基本上必须重新创建条形图和按钮。以下是改进的代码：

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

仅显示某些xls文件的自定义工具栏

2 个答案: