通过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

到此，一个来工具栏的宏大功告成了。