今天做文档,用公司的TOOLBAR进行版本信息修改,觉得很棒,就搜索了下怎样给WORD添加TOOLBAR的实现方法,特此记录。
Sub AddNewCB()
Dim myCommandBar As CommandBar, myCommandBarCtl As CommandBarControl
On Error GoTo AddNewCB_Err
Set myCommandBar = CommandBars.Add(Name:="Sample Toolbar", Position:= _
msoBarFloating)
myCommandBar.Visible = True
Set myCommandBarCtl = myCommandBar.Controls.Add(msoControlComboBox)
With myCommandBarCtl
.Caption = "Drop Down"
.Width = 300
.AddItem "Fred", 1
.AddItem "2012", 2
.DropDownWidth = 300
.OnAction = ""
End With
Exit Sub
AddNewCB_Err:
MsgBox "Error " & Err.Number & vbCr & Err.Description
Exit Sub
End Sub
Function AddRemoveButton()
Dim myCommandBar As CommandBar, CBCombo As CommandBarComboBox
Dim CBNewButton As CommandBarButton
On Error GoTo AddRemoveButton_Err
Set myCommandBar = CommandBars("Sample Toolbar")
Set CBCombo = myCommandBar.Controls(3)
Select Case CBCombo.ListIndex
Case 1
Set CBNewButton = myCommandBar.Controls.Add(Type:=msoControlButton)
With CBNewButton
.Caption = "New Button"
.Style = msoButtonCaption
.BeginGroup = True
.Tag = "New Button"
.OnAction = "=MsgBox(""This is a new button!"")"
End With
Case 2
Set CBNewButton = myCommandBar.FindControl(Tag:="New Button")
CBNewButton.Delete
End Select
Exit Function
AddRemoveButton_Err:
If Err.Number = 91 Then
MsgBox "Cannot remove button that does not exist!"
Exit Function
Else
MsgBox "Error " & Err.Number & vbCr & Err.Description
Exit Function
End If
End Function