1. 程式人生 > >Excel開發(VBA)— 在Excel裡自動新增工具欄

Excel開發(VBA)— 在Excel裡自動新增工具欄

      Office由於提供了VBA,為大家開發一些定製功能提供了一種途徑。但是如何實現工具欄中的命令與巨集進行繫結,對於初學則來說是一個不小的門檻。

     今天,給大家介紹一下在Excel裡寫完巨集後,如何通過巨集自動生成工具欄。

如圖:

工具欄

在VBA中將要用到CommandBar,CommandBarButton兩個物件。

Option Explicit

'定義全域性變數

Private zyi_Bar As CommandBar
Private zyi_ComBarBtn  As CommandBarButton

'-------------------------------------------------------------------------------------------------------------

'增加工具欄

'-------------------------------------------------------------------------------------------------------------

Sub AddToolBar()
'
'

'
 '   Application.CommandBars.Add(Name:="zy").Visible = True
 
Dim strBarName As String
Dim strParam As String
Dim strCaption As String
Dim strCommand As String
Dim nIndex As Integer
Dim nFaceId As Integer

Dim cBar As CommandBar

strBarName = "ZYI_TOOL"


For Each cBar In Application.CommandBars
    If cBar.Name = strBarName Then
        Set zyi_Bar = cBar
        GoTo 20
    End If
Next

'On Error GoTo 10
'Set zyi_Bar = Application.CommandBars(strBarName)
'If zyi_Bar.Name = strBarName Then
'  GoTo 20    '已經存在
'  zyi_Bar.Delete
'End If

'10:

On Error GoTo 100


Set zyi_Bar = Application.CommandBars.Add(Name:=strBarName)

20:
zyi_Bar.Visible = True

On Error GoTo 100

'-----------------------------------------------------------
'1. 複製工作表


nIndex = 1
strCaption = "複製工作表"
strParam = "複製工作表的單元格內容及格式!"
strCommand = "複製工作表"
nFaceId = 271
If zyi_Bar.Controls.Count < nIndex Then
   AddComBarBtn strParam, strCaption, strCommand, nIndex, nFaceId
ElseIf zyi_Bar.Controls(nIndex).Caption <> strCaption Then
    AddComBarBtn strParam, strCaption, strCommand, nIndex, nFaceId
End If

'-----------------------------------------------------------
'2. 合併單元格


nIndex = 2
strCaption = "合併單元格"
strParam = "合併單元格以及居中"
strCommand = "合併單元格"
nFaceId = 29
If zyi_Bar.Controls.Count < nIndex Then
   AddComBarBtn strParam, strCaption, strCommand, nIndex, nFaceId
ElseIf zyi_Bar.Controls(nIndex).Caption <> strCaption Then
    AddComBarBtn strParam, strCaption, strCommand, nIndex, nFaceId
End If

'-----------------------------------------------------------
'3. 居中


nIndex = 3
strCaption = "居中"
strParam = "水平垂直居中"
strCommand = "居中單元格"
nFaceId = 482
If zyi_Bar.Controls.Count < nIndex Then
   AddComBarBtn strParam, strCaption, strCommand, nIndex, nFaceId
ElseIf zyi_Bar.Controls(nIndex).Caption <> strCaption Then
    AddComBarBtn strParam, strCaption, strCommand, nIndex, nFaceId
End If

'-----------------------------------------------------------

'4. 貨幣


nIndex = 4
strCaption = "貨幣"
strParam = "貨幣"
strCommand = "貨幣"
nFaceId = 272
If zyi_Bar.Controls.Count < nIndex Then
   AddComBarBtn strParam, strCaption, strCommand, nIndex, nFaceId
ElseIf zyi_Bar.Controls(nIndex).Caption <> strCaption Then
    AddComBarBtn strParam, strCaption, strCommand, nIndex, nFaceId
End If

'-----------------------------------------------------------
'5. 將貨幣數字轉換為大寫


nIndex = 5
strCaption = "刪除列"
strParam = "刪除列"
'巨集名稱
strCommand = "刪除列"
nFaceId = 1668
If zyi_Bar.Controls.Count < nIndex Then
   AddComBarBtn strParam, strCaption, strCommand, nIndex, nFaceId
ElseIf zyi_Bar.Controls(nIndex).Caption <> strCaption Then
    AddComBarBtn strParam, strCaption, strCommand, nIndex, nFaceId
End If

nIndex = nIndex + 1
While nIndex < zyi_Bar.Controls.Count
    zyi_Bar.Controls(nIndex).Delete
Wend

'-----------------------------------------------------------

'6. 分割條
zyi_Bar.Controls(zyi_Bar.Controls.Count).BeginGroup = True

'-----------------------------------------------------------

'7. 將貨幣數字轉換為大寫


nIndex = 6
strCaption = "人民幣"
strParam = "人民幣由數字轉換為大寫"

'巨集名稱
strCommand = "To大寫人民幣"
nFaceId = 384
If zyi_Bar.Controls.Count < nIndex Then
   AddComBarBtn strParam, strCaption, strCommand, nIndex, nFaceId
ElseIf zyi_Bar.Controls(nIndex).Caption <> strCaption Then
    AddComBarBtn strParam, strCaption, strCommand, nIndex, nFaceId
End If

nIndex = nIndex + 1
While nIndex < zyi_Bar.Controls.Count
    zyi_Bar.Controls(nIndex).Delete
Wend

'-----------------------------------------------------------

'9. 分割條
zyi_Bar.Controls(zyi_Bar.Controls.Count).BeginGroup = True

100:

End Sub

'-------------------------------------------------------------------------------------------------------------

'向工具欄動態新增按鈕

'-------------------------------------------------------------------------------------------------------------

Sub AddComBarBtn(strParam As String, strCaption As String, strCommand As String, nIndex As Integer, nFaceId As Integer)
'
Set zyi_ComBarBtn = zyi_Bar.Controls.Add( _
        ID:=1, _
        Parameter:=strParam, _
        Before:=nIndex, _
        Temporary:=True)
       
With zyi_ComBarBtn
    .Caption = strCaption
    .Visible = True
    .OnAction = strCommand
    .FaceId = nFaceId
End With

End Sub

通過以上兩個函式,就可以實現自動新增工具欄及按鈕。

剩下將在Workbook_Open函式裡呼叫AddToolBar,即可實現檔案開啟就會顯示工具欄。如果僅作為工具存放,則可以把該檔案儲存為模版檔案,即xxx.xla。

Private Sub Workbook_Open()


'   MsgBox "歡迎使用Excel", vbInformation + vbOKOnly, "增強工具"
    Application.StatusBar = "歡迎使用增強工具:zyi"

   '顯示工具欄
    AddToolBar


End Sub

到此,一個來工具欄的巨集大功告成了。