★創建工具列功能表★

linyancheng

Sub 創建工具列功能表()

    On Error Resume Next
   
    Dim X As Long
    Dim 按鈕陣列 As Variant
    Dim 工具列 As Object
    Dim 新功能表按鈕 As Object
    Dim 按鈕 As Object
    Dim 工具列名稱 As String
   
    '編輯區，其他部分不須編輯==================================================================================================
    '◎表按鈕置於工具列上，否則置於新功能表上
    '★表新功能表銨鈕
    '▲表按鈕開始群組，可單獨使用，否則必須緊接在◎、★之後
    '非◎者一定要置於★項目之後
    '陣列元素名稱須為Sub名稱（★項目除外）
   
    按鈕陣列 = Array("◎VBA1", "★VBA2", "VBA3", "▲VBA4", "◎▲VBA5", "★▲VBA6", "VBA7", "VBA8", "▲VBA9")
   
    工具列名稱 = "VBA"
    '==================================================================================================
   
    Set 工具列 = Application.CommandBars.Add(Name:=工具列名稱, Position:=msoBarTop, Temporary:=True)
   
    工具列.Visible = True
   
    For X = 1 To UBound(按鈕陣列)
        If Left(按鈕陣列(X), 1) = "◎" Then
            Set 按鈕 = 工具列.Controls.Add(Type:=msoControlButton, Temporary:=True)
            
            With 按鈕
                .Caption = Replace(按鈕陣列(X), "◎", "")
                .Caption = Replace(.Caption, "▲", "")
                .Caption = Replace(.Caption, "Show", "")
                .Style = msoButtonCaption
                .OnAction = Replace(按鈕陣列(X), "◎", "")
                .OnAction = Replace(.OnAction, "▲", "")
               
                If Not InStr(Left(按鈕陣列(X), 2), "▲") = 0 Then
                    .BeginGroup = True
                End If
            End With
        ElseIf Left(按鈕陣列(X), 1) = "★" Then
            Set 新功能表按鈕 = 工具列.Controls.Add(Type:=msoControlPopup, Temporary:=True)
            
            With 新功能表按鈕
                .Caption = Replace(按鈕陣列(X), "★", "")
                .Caption = Replace(.Caption, "▲", "")
                .Style = msoButtonCaption
               
                If Not InStr(Left(按鈕陣列(X), 2), "▲") = 0 Then
                    .BeginGroup = True
                End If
            End With
        Else
            Set 按鈕 = 新功能表按鈕.CommandBar.Controls.Add(Type:=msoControlButton, Temporary:=True)
            
            With 按鈕
                .Caption = Replace(按鈕陣列(X), "▲", "")
                .Caption = Replace(.Caption, "Show", "")
                .Style = msoButtonCaption
                .OnAction = Replace(按鈕陣列(X), "▲", "")
               
                If Not InStr(Left(按鈕陣列(X), 2), "▲") = 0 Then
                    .BeginGroup = True
                End If
            End With
        End If
    Next X

End Sub

yipianshuye

谢谢楼主分享

linyancheng

.Caption = Replace(.Caption, "Show", "")
這行不需要的話可以刪除。

ningyong58

看起来容易，用起来就是一个小弯转不过来。