Excel-macro's geschikt maken voor anderen

Option Explicit

Dim vReply As Variant
Dim AddInLibPath As String
Dim CurAddInPath As String
Const sAppName As String = "Demobestand maken menu"
Const sFilename As String = "xlUtilDemo.xlam"
Const sRegKey As String = "xlUtilDemo"    ''' RegKey for settings

Sub Setup()
    vReply = MsgBox("De invoegtoepassing '" & sAppName & "'" & vbNewLine & _
    "zal in uw standaard invoegtoepassingenmap" & vbNewLine & _
    "worden geinstalleerd," & vbNewLine & vbNewLine & "doorgaan?", _
    vbYesNo, sAppName & " Setup")
    If vReply = vbYes Then
        On Error Resume Next
        Workbooks(sFilename).Close False
        CurAddInPath = ThisWorkbook.Path & "\" & sFilename
        AddInLibPath = Application.LibraryPath & "\" & sFilename
        'User librarypath does not have a trailing path separator
        'AddInLibPath = Application.UserLibraryPath & sFilename
        On Error Resume Next
        FileCopy CurAddInPath, AddInLibPath
        If Err.Number <> 0 Then
            SomeThingWrong
            Exit Sub
        End If
        With AddIns.Add(Filename:=AddInLibPath)
        .Installed = True
        End With
    Else
    vReply = MsgBox(prompt:="Installatie geannuleerd.", Buttons:=vbOKOnly, Title:=sAppName & " Setup")
    End If
End Sub

Sub SomeThingWrong()
    vReply = MsgBox(prompt:="Er ging iets mis tijdens het kopieren" & vbNewLine _
    & "van de invoegtoepassinge naar de invoegtoepassingenmap:" _
    & vbNewLine & vbNewLine & Application.LibraryPath & "\" _
    & vbNewLine & vbNewLine & "U kunt " & sAppName & " handmatig installeren door het bestand" _
    & vbNewLine & sFilename & " zelf naar deze map te kopieren " _
    & vbNewLine & "en vervolgens installeren door" & vbNewLine _
    & "Extra, Invoegtoepassingen te kiezen uit het menu." _
    & vbNewLine & vbNewLine & "Klik nog niet op OK, doe eerst het kopieren met Windows Verkenner." _
    & vbNewLine & "U kunt dan even terug naar dit venster om het pad te controleren.", _
    Buttons:=vbOKOnly, Title:=sAppName & " Setup")
End Sub

Sub Uninstall()
    vReply = MsgBox("Wilt u de invoegtoepassing " & sAppName & vbNewLine & _
    "van uw systeem verwijderen?", vbYesNo, sAppName & " Setup")
    If vReply = vbYes Then
        CurAddInPath = ThisWorkbook.Path & "\" & sFilename
        AddInLibPath = Application.LibraryPath & "\" & sFilename
        On Error Resume Next
        Workbooks(sFilename).Close False
        Kill AddInLibPath
        DeleteSetting sRegKey
        MsgBox "De invoegtoepassinge " & sAppName & " is van uw systeem verwijderd." _
        & vbNewLine & "Om het verwijderen te completeren dient u  " & sAppName _
        & vbNewLine & "in het volgende dialoogvenster te" & vbNewLine _
        & "selecteren en akkoord te gaan met de vraag" & vbNewLine & _
        "of deze uit de lijst mag worden verwijderd.", vbInformation + vbOKOnly
        Application.CommandBars(1).FindControl(ID:=943, recursive:=True).Execute
    End If
End Sub