Sample Code For An XLA Add-In
This page contains sample code for an XLA Add-In.
This page contains sample code for the XLA Add-In described at Creating An XLA Add-In.
Option Explicit
Private Const C_TAG = "ChipAddIn"
Private Const C_TOOLS_MENU_ID As Long = 30007&
Private Sub Workbook_Open()
Dim ToolsMenu As Office.CommandBarControl
Dim ToolsMenuItem As Office.CommandBarControl
Dim ToolsMenuControl As Office.CommandBarControl
DeleteControls
Set ToolsMenu = Application.CommandBars.FindControl(ID:=C_TOOLS_MENU_ID)
If ToolsMenu Is Nothing Then
MsgBox "Unable to access Tools menu.", vbOKOnly
Exit Sub
End If
Set ToolsMenuItem = ToolsMenu.Controls.Add(Type:=msoControlPopup, temporary:=True)
If ToolsMenuItem Is Nothing Then
MsgBox "Unable to add item to the Tools menu.", vbOKOnly
Exit Sub
End If
With ToolsMenuItem
.Caption = "&Menu Item"
.BeginGroup = True
.Tag = C_TAG
End With
Set ToolsMenuControl = ToolsMenuItem.Controls.Add(Type:=msoControlButton, temporary:=True)
If ToolsMenuControl Is Nothing Then
MsgBox "Unable to add item to Tools menu item.", vbOKOnly
Exit Sub
End If
With ToolsMenuControl
.Caption = "Click Me &One"
.OnAction = "'" & ThisWorkbook.Name & "'!MacroToRunOne"
.Tag = C_TAG
End With
Set ToolsMenuControl = ToolsMenuItem.Controls.Add(Type:=msoControlButton, temporary:=True)
If ToolsMenuControl Is Nothing Then
MsgBox "Unable to add item to Tools menu item.", vbOKOnly
Exit Sub
End If
With ToolsMenuControl
.Caption = "Click Me &Two"
.OnAction = "'" & ThisWorkbook.Name & "'!MacroToRunTwo"
.Tag = C_TAG
End With
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
DeleteControls
End Sub
Private Sub DeleteControls()
Dim Ctrl As Office.CommandBarControl
On Error Resume Next
Set Ctrl = Application.CommandBars.FindControl(Tag:=C_TAG)
Do Until Ctrl Is Nothing
Ctrl.Delete
Set Ctrl = Application.CommandBars.FindControl(Tag:=C_TAG)
Loop
End Sub
Option Explicit
Sub MacroToRunOne()
Dim S As String
S = "Hello World From One:" & vbCrLf & _
"This Add-In File Name: " & ThisWorkbook.FullName
MsgBox S
End Sub
Sub MacroToRunTwo()
Dim S As String
S = "Hello World From Two:" & vbCrLf & _
"This Add-In File Name: " & ThisWorkbook.FullName
MsgBox S
End Sub
This page last updated: 8-October-2007