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 'command bar event handler
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
AddInCombo
End Sub
Private Sub AddInCombo()
Dim thisProject As VBProject
Dim pComponents As Integer
Dim i As Integer
Set thisProject = VBInstance.ActiveVBProject
pComponents = thisProject.VBComponents.Count
mfrmAddIn.cboForm.Clear
For i = 1 To pComponents
If thisProject.VBComponents.Item(i).Type = vbext_ct_VBForm Then
mfrmAddIn.cboForm.AddItem thisProject.VBComponents.Item(i).Name
End If
Next
On Error Resume Next
mfrmAddIn.cboForm.Text = mfrmAddIn.cboForm.List(0)
Set thisProject = Nothing
End Sub
'------------------------------------------------------
'this method adds the Add-In to 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
'save the vb instance
Set VBInstance = Application
'this is a good place to set a breakpoint and
'test various addin objects, properties and methods
Debug.Print VBInstance.FullName
If ConnectMode = ext_cm_External Then
'Used by the wizard toolbar to start this wizard
Me.Show
Else
Set mcbMenuCommandBar = AddToAddInCommandBar("SideMenu")
'sink the event
Set Me.MenuHandler = VBInstance.Events.CommandBarEvents(mcbMenuCommandBar)
End If
If ConnectMode = ext_cm_AfterStartup Then
If GetSetting(App.Title, "Settings", "DisplayOnConnect", "0") = "1" Then
'set this to display the form on connect
Me.Show
End If
End If
Exit Sub
error_handler:
MsgBox Err.Description
End Sub
'------------------------------------------------------
'this method removes the Add-In from VB
'------------------------------------------------------
Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode As _
AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)
On Error Resume Next
'delete the command bar entry
mcbMenuCommandBar.Delete
'shut down the Add-In
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
'set this to display the form on connect
Me.Show
End If
End Sub
'this event fires when the menu is clicked in the 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 'command bar object
Dim cbMenu As Object
On Error GoTo AddToAddInCommandBarErr
'see if we can find the Add-Ins menu
Set cbMenu = VBInstance.CommandBars("Add-Ins")
If cbMenu Is Nothing Then
'not available so we fail
Exit Function
End If
'add it to the command bar
Set cbMenuCommandBar = cbMenu.Controls.Add(1)
'set the caption
cbMenuCommandBar.Caption = sCaption
'____________________________________________
'Сюда вставляется код для картинки меню
cbMenuCommandBar.OnAction = "hello"
'copy the icon to the clipboard
Clipboard.SetData LoadResPicture(5000, 0)
'set the icon for the button
cbMenuCommandBar.PasteFace
'____________________________________________
Set AddToAddInCommandBar = cbMenuCommandBar
Exit Function
AddToAddInCommandBarErr:
End Function
| К статье | Продолжение листинга |