2007/7/17更新
如果你需要此VBA加载宏，请访问 http://my.mofile.com/benjaminwan
或直接提取
简体中文:http://pickup.mofile.com/5505481867922136
繁体中文:http://pickup.mofile.com/0900889919321666
本文假设读者有一定的Excel的VBA基础。故某些基础问题不做详解。
一、原理
实际上每次打开Excel，也会每次都加载宏。
故想让浮动工具条在每次打开Excel后都出现，只要在你写程序的Excel文件的Thisworkbook里做些手脚就可以了。
如果是XLA 文件，VBA入口为 Workbook_AddinInstall/Workbook_AddinUninstall
如果是XLS 文件，VBA入口为 Workbook_Open/Workbook_BeforeClose
一个是打开后执行的(可以用于加载工具条)，一个是要关闭前执行(可以用来卸载工具条)。
二、先做一个添加工具条函数吧
先添加一个模块，然后在这个模块中写入如下语句
‘先定义一下工具条的名字及工具条上按钮的名字
Public Const TECH_TOOLBAR_NAME As String = “技术工具箱”
Public Const CPK_TOOL_NAME As String = “CPK工具”
Public Const MAP_TOOL_NAME As String = “单分布图工具”
Public Const Multi_MAP_TOOL_NAME As String = “对比分布图工具”
Public Const STAMP_TOOL_NAME As String = “电子印章工具”
Public Const ABOUT_TOOL_NAME As String = “关于”
‘下面写一个添加工具条的函数
Public Sub AddToolbar()
Dim mybar As Object
‘添加工具条，msoBarTop即代表浮动工具条
Application.CommandBars.Add Name:=TECH_TOOLBAR_NAME, >
CommandBars(TECH_TOOLBAR_NAME).Visible = True
‘添加CPK按钮，Before:=1代表这个按钮在工具条的第一格
Set mybar = Application.CommandBars(TECH_TOOLBAR_NAME).Controls.Add(Type:=msoControlButton, Before:=1)
ThisWorkbook.Worksheets(“source”).Shapes(“Icon_CPK”).Copy ‘设置按钮图标
‘这一步要先在此文档里建一个名为source的工作表，然后再这工作表里帖入一个图像或艺
’术字，并把这个图像的名称改为Icon_CPK
With mybar
.OnAction = “show_CPK_window” ‘按下此按钮要执行的函数
.PasteFace
.TooltipText = CPK_TOOL_NAME ‘鼠标停在此按钮上要显示的文字
End With
‘添加单分布图工具按钮
Set mybar = Application.CommandBars(TECH_TOOLBAR_NAME).Controls.Add(Type:=msoControlButton, Before:=2)
ThisWorkbook.Worksheets(“source”).Shapes(“Icon_MAP”).Copy
With mybar
.OnAction = “show_MAP_window”
.PasteFace
.TooltipText = MAP_TOOL_NAME
End With
‘添加对比分布图工具按钮
Set mybar = Application.CommandBars(TECH_TOOLBAR_NAME).Controls.Add(Type:=msoControlButton, Before:=3)
ThisWorkbook.Worksheets(“source”).Shapes(“ICON_MAP_Multi”).Copy
With mybar
.OnAction = “show_multi_MAP_window”
.PasteFace
.TooltipText = Multi_MAP_TOOL_NAME
End With
‘添加电子印章工具按钮
Set mybar = Application.CommandBars(TECH_TOOLBAR_NAME).Controls.Add(Type:=msoControlButton, Before:=4)
ThisWorkbook.Worksheets(“source”).Shapes(“ICON_STAMP”).Copy
With mybar
.OnAction = “show_STAMP_window”
.PasteFace
.TooltipText = STAMP_TOOL_NAME
End With
‘添加about按钮
Set mybar = Application.CommandBars(TECH_TOOLBAR_NAME).Controls.Add(Type:=msoControlButton, Before:=5)
ThisWorkbook.Worksheets(“source”).Shapes(“ICON_about”).Copy
With mybar
.OnAction = “show_about_window”
.PasteFace
.TooltipText = ABOUT_TOOL_NAME
End With
End Sub
三、删除工具条
Public Sub Delmenu()
Application.CommandBars(TECH_TOOLBAR_NAME).Delete
End Sub
四、在Thisworkbook中添加如下代码，使添加按钮函数可以自动运行
‘下代码可以实现：不论xls或xla都能够自动添加按钮
Private Sub Workbook_AddinInstall()
Application.ScreenUpdating = False
If GetSetting(“TECH_tools”, “Startup”, “toolbar”) = “” Then
SaveSetting “TECH_tools”, “Startup”, “toolbar”, “1”
Call AddToolbar
End If
Application.ScreenUpdating = True
End Sub
Private Sub Workbook_AddinUninstall()
Dim tempbar As CommandBars
On Error Resume Next
If Application.CommandBars(TECH_TOOLBAR_NAME).Name = TECH_TOOLBAR_NAME Then
End If
If Err.Number <> 0 Then
Err.Clear
SaveSetting “TECH_tools”, “Startup”, “toolbar”, “”
End If
End Sub
Private Sub Workbook_Open()
Call Workbook_AddinInstall
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call Workbook_AddinUninstall
End Sub
——————————————
benjaminwan
2007-6-17
什么天荒地老，什么至死不渝。都只是锦上添花的借口…