CoderHelper 如何添加工具条以及工具条中的按钮的?
首先,你需要添加此函数到你的模块中:
Function AddCommandBar(sCaption As String, Owner As String, ResIconID As Long, Optional Before) As Office.CommandBarControl
Dim cbMenuCommandBar As Office.CommandBarControl '命令栏对象
Dim cbMenu As CommandBar
On Error GoTo AddToAddInCommandBarErr
'察看能否找到外接程序菜单
Set cbMenu = VBI.CommandBars(Owner)
If cbMenu Is Nothing Then
'没有有效的外接程序,过程失败
Exit Function
End If
'添加它到命令栏
Set cbMenuCommandBar = cbMenu.Controls.Add(1, , , Before)
'设置标题
cbMenuCommandBar.Caption = sCaption
Clipboard.Clear
Clipboard.SetData LoadResPicture(ResIconID, vbResBitmap)
'为此按钮设置图标
cbMenuCommandBar.PasteFace
Clipboard.Clear
Set AddCommandBar = cbMenuCommandBar
Exit Function
AddToAddInCommandBarErr:
End Function
Public Function AddToMenu(txtCaption As String, Owner As String, ResIconID As Long, Optional Before, Optional ID As Long) As CommandBarEvents
Dim cMenu As Object
Set cMenu = AddCommandBar(txtCaption, Owner, ResIconID, Before)
'吸取事件
Set AddToMenu = VBI.Events.CommandBarEvents(cMenu)
End Function
接着,你需要调用 VBI.CommandBars.Add 来添加一个工具栏.添加方法如下:
VBI.CommandBars.Add MyName
CoderHelper中定义了以下代码.(部分)
Public WithEvents MenuHandler As CommandBarEvents '命令栏事件句柄
Public WithEvents ClsSpyEvt As CommandBarEvents
Public WithEvents cZoom As CommandBarEvents
Public WithEvents VbPjtsEvents As VBProjectsEvents
Public WithEvents wWebB As CommandBarEvents
使用以下代码对应了事件
Set Me.MenuHandler = AddToMenu("程序员助手", MyName, 101)
Set ClsSpyEvt = AddToMenu("类侦探工具", MyName, 104)
Set cZoom = AddToMenu("放大镜工具", MyName, 105)
Set wWebB = AddToMenu("内置浏览器", MyName, 106)
Set weobjGetColor = AddToMenu("屏幕颜色自动提取器", MyName, 110)
Set VBCC = AddToMenu("代码注释Web页生成器", MyName, 107)
Set HtmlHelpMaker = AddToMenu("应用程序帮助文件生成工具", MyName, 108)
使用以下方法响应该事件
Private Sub ClsSpyEvt_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean)
On Error Resume Next
Static i As Boolean
i = Not i
DoCommand "clsspy", IIf(i, "/onload", "/offload")'直接执行命令行命令.
End Sub
Private Sub Lng_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean)
Dim Obj As Object
On Error GoTo errH
Dim xx As Object
Set Obj = CreateObject("VBMultiLanguage.Connect")'注意,这里采用了后期绑定方法.
Set xx = MVBI
Call Obj.show1(xx)
Call Obj.show
errH:
If err.Number <> 0 Then
WriteLine "启动多语言辅助工具时出错:" + err.Description, vbRed
End If
End Sub
