wimgielis.com

Switchen tussen add-in en basisbestand

• 04/11/2016

	Voorbeeldbestanden bij dit artikel:
	Switchen tussen add-in en basisbestand

Inleiding

Naast al mijn Excel activiteiten op forums en deze website, ben ik ook bezig aan mijn eigen lint van veelgebruikte macro's. Je kent het wel: een macro om snel formules naar harde waarden om te zetten, macro's om draaitabellen te manipuleren, enz. De macro's en de icoontjes in het lint maak in een Excel bestand met extensie "*.xlsm". Vervolgens sla ik dat bestand op met extensie "*.xlam" om er een addin (invoegtoepassing) van te maken.

Nu, schakelen tussen beide bestanden is niet altijd evident. Zeg maar tijdrovend. Vandaar dat ik in mijn Personal.xlsb (persoonlijk macrowerkboek) ook een vijftal procedures toevoegde om te switchen tussen de xlsm versie (veelal voor ontwikkelen) en de xlam versie (veelal voor testen en gebruiken):

• Addin_SAVE_AS: het opslaan van de xlsm als xlam, de xlsm versie is niet meer geopend
• Addin_INSTALLED: het installeren van de xlam versie, de xlsm versie is niet meer geopend
• Addin_NO_ADDIN: de xlam versie wordt gedesinstalleerd en de xlsm versie is ook niet meer geopend
• Addin_UNINSTALLED: het desinstalleren van de xlam versie, de xlsm versie is wordt geopend
• Addin_TOGGLE_VISIBILITY: het zichtbaar of onzichtbaar van de xlam versie

Mijn code

Hieronder geef ik jullie mijn 4 zeer tijdsbesparende procedures:

Const Addin_FileName As String = "Menu_Wim.xlsm"

' Wim Gielis
' https://www.wimgielis.com
'''''
' Procedures om te switchen tussen een bestand en zijn invoegtoepassing
' 04/11/16
'''''

Sub Addin__SAVE_AS()
'''''
' PURPOSE:
' - save the active workbook as an addin
' - the extension is "preserved": xls ==> xla, xlx/xlsm ==> xlam
'''''

    On Error Resume Next

    Dim o                     As Object
    Dim sFileName_Addin       As String
    Set o = CreateObject("scripting.filesystemobject")

    Application.DisplayAlerts = False

    With ActiveWorkbook

        If .Name <> Addin_FileName Then MsgBox "Wrong file to be saved": Exit Sub
    
        .Save

        Select Case o.GetExtensionName(.FullName)
        Case "xls"
            sExtension = "xla"
            lExtension = 18
        Case "xlsx", "xlsm"
            sExtension = "xlam"
            lExtension = 55
        Case Else
            lExtension = 0
        End Select

        sFileName_Addin = Application.UserLibraryPath & o.GetBaseName(.FullName) & "." & sExtension

        If CDbl(CDate(FileDateTime(.FullName))) < CDbl(CDate(FileDateTime(sFileName_Addin))) Then

            'the addin file is more recent than the source file
            If MsgBox("The addin file is more recent than the source file. Do you want to CONTINUE ?", vbYesNoCancel) <> vbYes Then
                GoTo LastSteps
            End If

        End If

        Addin_UNINSTALLED

        '.SaveAs Filename:="C:\Users\WGielis\AppData\Roaming\Microsoft\AddIns\Menu_Wim.xlam", FileFormat:=xlOpenXMLAddIn, CreateBackup:=False
        .SaveAs Filename:=sFileName_Addin, FileFormat:=lExtension, CreateBackup:=False

    End With

LastSteps:
    Application.DisplayAlerts = True

    On Error GoTo 0

    Addin_INSTALLED

End Sub

Sub Addin_INSTALLED()
'''''
' PURPOSE:
' - install the add-in
' - close the base xlsm file
'''''

    On Error Resume Next
    'Workbooks("Menu_Wim.xlsm").Close True
    Workbooks(Addin_FileName).Close True
    On Error GoTo 0

    'With Addins("Menu_Wim")
    With AddIns(CreateObject("Scripting.FileSystemObject").GetBaseName(Application.UserLibraryPath & Addin_FileName))
        If Not .Installed Then .Installed = True
    End With

    If Workbooks.Count <= 1 Then Workbooks.Add

End Sub

Sub Addin_UNINSTALLED()
'''''
' PURPOSE:
' - uninstall the add-in
' - open the base xlsm file
'''''

    'With Addins("Menu_Wim")
    With AddIns(CreateObject("Scripting.FileSystemObject").GetBaseName(Application.UserLibraryPath & Addin_FileName))
        If .Installed Then .Installed = False
    End With

    On Error Resume Next
    'If Workbooks("Menu_Wim.xlsm") Is Nothing Then
        'Workbooks.Open "C:\Users\WGielis\AppData\Roaming\Microsoft\AddIns\Menu_Wim.xlsm"
    'End If
    If Workbooks(Addin_FileName) Is Nothing Then
        Workbooks.Open Application.UserLibraryPath & Addin_FileName
    End If
    On Error GoTo 0

End Sub

Sub Addin_TOGGLE_VISIBILITY()
'''''
' PURPOSE:
' - allow the addin to be visible
'''''

    'Change the .IsAddin property
    On Error Resume Next
    'With Workbooks(Menu_Wim.xlam)
    With Workbooks(AddIns(CreateObject("Scripting.FileSystemObject").GetBaseName(Application.UserLibraryPath & Addin_FileName)).Name)
        .IsAddin = Not .IsAddin
    End With
    On Error GoTo 0

End Sub

Sub Addin_NO_ADDIN()
'''''
' PURPOSE:
' - uninstall the add-in
' - close the base xlsm file
'''''

    'With Addins("Menu_Wim")
    With AddIns(CreateObject("Scripting.FileSystemObject").GetBaseName(Application.UserLibraryPath & Addin_FileName))
        If .Installed Then .Installed = False
    End With

    On Error Resume Next
    'If Not Workbooks("Menu_Wim.xlsm") Is Nothing Then
    '    Workbooks("Menu_Wim.xlsm").Close
    'End If
    If Not Workbooks(Addin_FileName) Is Nothing Then
        Workbooks(Addin_FileName).Close
    End If
    On Error GoTo 0

End Sub

De code helemaal bespreken heeft weinig zin vermoed ik, zij die dit gaan gebruiken en verstand hebben van invoegtoepassingen, begrijpen volgens mij wel de betekenis van de codes. In de code heb ik de echte paden naar de bestanden geplaatst, dat zegt wellicht meer dan enkel de VBA-variant. Vergeet zeker niet de constante Addin_FileName helemaal bovenaan de code module ! ("Menu_Wim.xlsm"). Tot slot vermeld ik nog dat beide bestanden (xlsm en xlam) zich bevinden in de folder van de invoegtoepassingen.

Hopelijk helpen deze codes om situaties te vermijden zoals wanneer je werkt in de xlam versie en die versie versie per ongeluk overschrijft met een oudere xlsm versie.

Ter info, mocht je aan de slag willen gaan met je eigen lint of nieuwe menu's, gebruik dan de Custom UI Editor For Microsoft Office. Kijk zeker hier bij Ron De Bruin voor nuttige info en voorbeelden.

Doe er gerust je voordeel mee, net als ik al een tijdje deze functies gebruik !

• « Vorig Excel artikel
• Volgend Excel artikel »