Last active
January 23, 2023 06:19
-
-
Save spookyuser/80cab6f9355e7b8b952919871aa8bc29 to your computer and use it in GitHub Desktop.
A combination of 2 super cool vba scripts that, together, allow you to distribute a simple button enabled excel macro without an installer
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
' All code comes from the following places: | |
' - https://stackoverflow.com/a/41546218/1649917 | |
' - https://www.ozgrid.com/VBA/excel-add-in-create.htm | |
Option Explicit | |
Dim cControl As CommandBarButton | |
' Set it to True to be able to Debug install mechanism | |
Const bVerboseMessages = False | |
' Will be use to verify if the procedure has already been run | |
Dim bAlreadyRun As Boolean | |
Sub MyInstallScript(ByVal location As String) | |
On Error Resume Next 'Just in case | |
'Delete any existing menu item that may have been left. | |
Application.CommandBars("Worksheet Menu Bar").Controls("MyAddin").Delete | |
'Add the new menu item and set a CommandBarButton variable to it | |
Set cControl = Application.CommandBars("Worksheet Menu Bar").Controls.Add | |
'Work with the Variable | |
With cControl | |
.Caption = "MyAddin" | |
.Style = msoButtonCaption | |
.OnAction = location & "!MyMacro" 'Macro stored in a Standard Module [Integration: Pass the location of the installed script as a variable here] | |
End With | |
On Error GoTo 0 | |
End Sub | |
Private Sub Workbook_AddinUninstall() | |
On Error Resume Next 'In case it has already gone. | |
Application.CommandBars("Worksheet Menu Bar").Controls("MyAddin").Delete | |
On Error GoTo 0 | |
End Sub | |
' (c) Willy Roche (willy.roche(at)centraliens.net) | |
' Install procedure of XLAM (library of functions) | |
' This procedure will install a file name .install.xlam in the proper excel directory | |
' The install package will be name | |
' During install you may be prompt to enable macros (accept it) | |
' You can accept to install or refuse (which let you modify the XLAM file macros or install procedure | |
Private Sub Workbook_Open() | |
' This sub will automatically start when xlam file is opened (both install version and installed version) | |
Dim oAddIn As Object, oXLApp As Object, oWorkbook As Workbook | |
Dim i As Integer | |
Dim iAddIn As Integer | |
Dim bAlreadyInstalled As Boolean | |
Dim sAddInName As String, sAddInFileName As String, sCurrentPath As String, sStandardPath As String | |
sCurrentPath = Me.Path & "\" | |
sStandardPath = Application.UserLibraryPath ' Should be Environ("AppData") & "\Microsoft\AddIns" | |
DebugBox ("Called from:'" & sCurrentPath & "'") | |
If InStr(1, Me.Name, ".install.xlam", vbTextCompare) Then | |
' This is an install version, so let’s pick the proper AddIn name | |
sAddInName = Left(Me.Name, InStr(1, Me.Name, ".install.xlam", vbTextCompare) - 1) | |
sAddInFileName = sAddInName & ".xlam" | |
' Avoid the re-entry of script after activating the addin | |
If Not (bAlreadyRun) Then | |
DebugBox ("Called from:'" & sCurrentPath & "' bAlreadyRun = false") | |
bAlreadyRun = True ' Ensure we won’t install it multiple times (because Excel reopen files after an XLAM installation) | |
If MsgBox("Do you want to install/overwrite '" & sAddInName & "' AddIn ?", vbYesNo) = vbYes Then | |
' Create a workbook otherwise, we get into troubles as Application.AddIns may not exist | |
Set oXLApp = Application | |
Set oWorkbook = oXLApp.Workbooks.Add | |
' Test if AddIn already installed | |
For i = 1 To Me.Application.AddIns.Count | |
If Me.Application.AddIns.Item(i).FullName = sStandardPath & sAddInFileName Then | |
bAlreadyInstalled = True | |
iAddIn = i | |
End If | |
Next i | |
If bAlreadyInstalled Then | |
' Already installed | |
DebugBox ("Called from:'" & sCurrentPath & "' Already installed") | |
If Me.Application.AddIns.Item(iAddIn).Installed Then | |
' Deactivate the add-in to be able to overwrite the file | |
Me.Application.AddIns.Item(iAddIn).Installed = False | |
Me.SaveCopyAs sStandardPath & sAddInFileName | |
Me.Application.AddIns.Item(iAddIn).Installed = True | |
MsgBox ("'" & sAddInName & "' AddIn Overwritten") | |
Else | |
Me.SaveCopyAs sStandardPath & sAddInFileName | |
Me.Application.AddIns.Item(iAddIn).Installed = True | |
MsgBox ("'" & sAddInName & "' AddIn Overwritten & Reactivated") | |
End If | |
MyInstallScript (sStandardPath & sAddInFileName) '[Integration: Register button here instead of Workbook_AddinInstall] | |
Else | |
' Not yet installed | |
DebugBox ("Called from:'" & sCurrentPath & "' Not installed") | |
Me.SaveCopyAs sStandardPath & sAddInFileName | |
Set oAddIn = oXLApp.AddIns.Add(sStandardPath & sAddInFileName, True) | |
MyInstallScript (sStandardPath & sAddInFileName) '[Integration: Register button here instead of Workbook_AddinInstall] | |
oAddIn.Installed = True | |
MsgBox ("'" & sAddInName & "' AddIn Installed and Activated") | |
End If | |
oWorkbook.Close (False) ' Close the workbook opened by the install script | |
oXLApp.Quit ' Close the app opened by the install script | |
Set oWorkbook = Nothing ' Free memory | |
Set oXLApp = Nothing ' Free memory | |
Me.Close (False) | |
End If | |
Else | |
DebugBox ("Called from:'" & sCurrentPath & "' Already Run") | |
' Already run, so nothing to do | |
End If | |
Else | |
DebugBox ("Called from:'" & sCurrentPath & "' in place") | |
' Already in right place, so nothing to do | |
End If | |
End Sub | |
Sub DebugBox(sText As String) | |
If bVerboseMessages Then MsgBox (sText) | |
End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment