VERSION 5.00 Begin {AC0714F6-3D04-11D1-AE7D-00A0C90F26F4} Connect ClientHeight = 9945 ClientLeft = 1740 ClientTop = 1545 ClientWidth = 6585 _ExtentX = 11615 _ExtentY = 17542 _Version = 393216 Description = "Add-In Project Template" DisplayName = "My Add-In" AppName = "Visual Basic" AppVer = "Visual Basic 98 (ver 6.0)" LoadName = "Command Line / Startup" LoadBehavior = 5 RegLocation = "HKEY_CURRENT_USER\Software\Microsoft\Visual Basic\6.0" CmdLineSupport = -1 'True End Attribute VB_Name = "Connect" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = True Option Explicit Public FormDisplayed As Boolean Public VBInstance As VBIDE.VBE Dim mcbMenuCommandBar As Office.CommandBarControl Dim mfrmAddIn As New frmAddIn Public WithEvents MenuHandler As CommandBarEvents '命令栏事件句柄 Attribute MenuHandler.VB_VarHelpID = -1 Sub Hide() On Error Resume Next FormDisplayed = False mfrmAddIn.Hide End Sub Sub Show() On Error Resume Next If mfrmAddIn Is Nothing Then Set mfrmAddIn = New frmAddIn End If Set mfrmAddIn.VBInstance = VBInstance Set mfrmAddIn.Connect = Me FormDisplayed = True mfrmAddIn.Show End Sub '------------------------------------------------------ '这个方法添加外接程序到 VB '------------------------------------------------------ Private Sub AddinInstance_OnConnection(ByVal Application As Object, ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant) On Error GoTo error_handler '保存 vb 实例 Set VBInstance = Application '这里是一个设置断点以及测试不同外接程序 '对象,属性及方法的适当位置 Debug.Print VBInstance.FullName If ConnectMode = ext_cm_External Then '用于让向导工具栏来启动此向导 Me.Show Else Set mcbMenuCommandBar = AddToAddInCommandBar("My AddIn") '吸取事件 Set Me.MenuHandler = VBInstance.Events.CommandBarEvents(mcbMenuCommandBar) End If If ConnectMode = ext_cm_AfterStartup Then If GetSetting(App.Title, "Settings", "DisplayOnConnect", "0") = "1" Then '设置这个到连接显示的窗体 Me.Show End If End If Exit Sub error_handler: MsgBox Err.Description End Sub '------------------------------------------------------ '这个方法从 VB 中删除外接程序 '------------------------------------------------------ Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant) On Error Resume Next '删除命令栏条目 mcbMenuCommandBar.Delete '关闭外接程序 If FormDisplayed Then SaveSetting App.Title, "Settings", "DisplayOnConnect", "1" FormDisplayed = False Else SaveSetting App.Title, "Settings", "DisplayOnConnect", "0" End If Unload mfrmAddIn Set mfrmAddIn = Nothing End Sub Private Sub IDTExtensibility_OnStartupComplete(custom() As Variant) If GetSetting(App.Title, "Settings", "DisplayOnConnect", "0") = "1" Then '设置这个到连接显示的窗体 Me.Show End If End Sub '当 IDE 中的菜单被单击时,这个事件被激活 Private Sub MenuHandler_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean) Me.Show End Sub Function AddToAddInCommandBar(sCaption As String) As Office.CommandBarControl Dim cbMenuCommandBar As Office.CommandBarControl '命令栏对象 Dim cbMenu As Object On Error GoTo AddToAddInCommandBarErr '察看能否找到外接程序菜单 Set cbMenu = VBInstance.CommandBars("Add-Ins") If cbMenu Is Nothing Then '没有有效的外接程序,过程失败 Exit Function End If '添加它到命令栏 Set cbMenuCommandBar = cbMenu.Controls.Add(1) '设置标题 cbMenuCommandBar.Caption = sCaption Set AddToAddInCommandBar = cbMenuCommandBar Exit Function AddToAddInCommandBarErr: End Function