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
