Excel addin in vba

An Excel Add-In is a file (usually with an .xla or .xll extension) that Excel can load when it starts up. The file contains code (VBA in the case of an .xla Add-In) that adds additional functionality to Excel, usually in the form of new functions.

Add-Ins provide an excellent way of increasing the power of Excel and they are the ideal vehicle for distributing your custom functions. Excel is shipped with a variety of Add-Ins ready for you to load and start using, and many third-party Add-Ins are available.

Setup

Open VBA Editor

Step 1. Open any Excel file

Step 2. With your new template open in Excel, on the Developer tab, click Visual Basic

• Hot key — Alt + F11
• If you cannot find your Developer tab, follow the instructions at this page.

Step 3. Now you can work on your VBA code

• For Sub as Workbook_Open(), Workbook_BeforeClose(Cancel As Boolean), please add your code to ThisWorkbook.
• For other Sub or Function, you can either write in ThisWorkbook or create a module to write in.

Save your add-in

Save your workbook as Microsoft Excel Add-in (*.xla, *.xlam) to C:WINDOWSApplication DataMicrosoftAddIns.

Then this add-in would be automatically add to your add-in group.

Create Custom Buttons

Create your custom buttons whenever a workbook is opened.

Private Sub Workbook_Open()

Application.DisplayAlerts = False

Dim CmdBar As CommandBar
Dim CmdBarCtl As CommandBarControl
Dim cmdBarSubCtl As CommandBarControl

On Error GoTo Err_Handler

Set CmdBar = Application.CommandBars("Worksheet Menu Bar")
CmdBar.Visible = True
CmdBar.Protection = msoBarNoMove


Set CmdBarCtl = CmdBar.Controls.Add(Type:=msoControlButton)
With CmdBarCtl
   .BeginGroup = True
   .Caption = "Single Button"
   .Style = msoButtonCaption
   .OnAction = "NameOfASub"
End With
Application.DisplayAlerts = True
Exit Sub


Set CmdBarCtl = CmdBar.Controls.Add(Type:=msoControlPopup)
CmdBarCtl.Caption = "Drop Down Button"

Set cmdBarSubCtl = CmdBarCtl.Controls.Add(Type:=msoControlButton)
With cmdBarSubCtl
   .Style = msoButtonIconAndCaption
   .Caption = "option 1"
   .FaceId = 317
   .OnAction = "NameOfASub"
   .Parameter = 1
   .BeginGroup = True
End With

Set cmdBarSubCtl = CmdBarCtl.Controls.Add(Type:=msoControlButton)
With cmdBarSubCtl
   .Style = msoButtonIconAndCaption
   .Caption = "option 2"
   .FaceId = 318
   .OnAction = "NameOfASub"
   .Parameter = 2
   .BeginGroup = True
End With

Set cmdBarSubCtl = CmdBarCtl.Controls.Add(Type:=msoControlButton)
With cmdBarSubCtl
   .Style = msoButtonIconAndCaption
   .Caption = "option 3"
   .FaceId = 224
   .OnAction = "NameOfASub"
   .Parameter = 3
   .BeginGroup = True
End With


Err_Handler:
MsgBox "Error " & Err.Number & vbCr & Err.Description
Application.DisplayAlerts = True
Exit Sub

End Sub

Note that you can refer to this link to choose the icon you want to show in the button.

Define Actions

.OnAction = "NameOfASub" means that a subfunction named NameOfASub is being called as an action of a click on the certain button. That is, you need to self-defined these actions.

 Public Sub NameOfASub()
     MsgBox("Hello World!")
 End Sub

Delete Custom Buttons Before Closed

Make sure you delete the button on closing Excel, otherwise an additional one will be added everytime you open a workbook.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim CmdBar As CommandBar
Set CmdBar = Application.CommandBars("Worksheet Menu Bar")
CmdBar.Controls("Single Button").Delete
CmdBar.Controls("Drop Down Button").Delete
End Sub

VBA Models

For detail information, please refer to Excel VBA official Webpage

Variable Declaration

Declare a variable

Dim cmd

Declare a variable with data type

Dim cmd As String

Declare a global variable

Public path As String

Assign value to a variable

Remember to add Set at the beginning.

Set path = "C:my_folder"

Range

Represents a cell, a row, a column, a selection of cells containing one or more contiguous blocks of cells, or a 3-D range.

Get a specific cell

Dim cell As Range
cell = ActiveSheet.Cells(1, 1)

Get a Range object that represents the used range on the specified worksheet. Read-only.

Dim range As Range

range = ActiveSheet.UsedRange
'OR
range = ActiveSheet.Range("A1").CurrentRegion

Set value/formula of a Range object

ActiveSheet.Cells(1, 1).Value = 24
ActiveSheet.Cells(2, 1).Formula = "=Sum(B1:B5)"

Get the number of rows used

Dim uTotalRows As Integer
uTotalRows = ActiveSheet.UsedRange.Rows.Count
MsgBox (uTotalRows)

Define/Call a Function

Define a function.

[Modifiers] Function FunctionName [(ParameterList)] As ReturnType

….Statements….

End Function

Function hypotenuse(ByVal side1 As Single, ByVal side2 As Single) As Single
    Return Math.Sqrt((side1 ^ 2) + (side2 ^ 2))
End Function

Call your defined function.

Dim testLength, testHypotenuse As Single
testHypotenuse = hypotenuse(testLength, 10.7)

String Concatenation

To concat string str1 with string str2, you can use the operator &.

Dim str1 As String
Dim str2 As String
...
Dim concat_str As String
concat_str = str1 & str2

Save the current workbook

ActiveWorkbook.Save

Get path and name of current workbook/sheet

Get path of current workbook

Dim path As String
path = Application.ActiveWorkbook.path

Get full path of current workbook (include workbook name)

Dim fullpath As String
fullpath = Application.ActiveWorkbook.FullName

Get name of current workbook

Dim bookname As String
bookname = ActiveWorkbook.Name

Get name of current sheet

Dim sheetname As String
sheetname = ActiveSheet.Name

Run an executable with parameters

Method 1. Use Shell

cmd = "myApp.exe" & " " & "myParameter"
retval = Shell(cmd, vbNormalFocus)

Method 2. Use WScript

(This method allows you to wait until the execution completes and returns.)

Set wsh = VBA.CreateObject("WScript.Shell")
Dim waitOnReturn As Boolean: waitOnReturn = True
Dim windowStyle As Integer: windowStyle = 1
cmd = "myApp.exe" & " " & "myParameter"
wsh.Run cmd, windowStyle, waitOnReturn

Open up an existing workbook

Open an existing workbook (pop-up)

Dim objXLApp, objXLWb
Set objXLApp = CreateObject("Excel.Application")
objXLApp.Visible = True
Set objXLWb = objXLApp.Workbooks.Open(report)
objXLWb.Sheets(sheetname).Activate

Open an existing workbook (invisible) in read-only mode

Dim wb As Workbook
Set wb = Workbooks.Open(Path_to_WB, True, True)

Flow Control

If Else

If condition [ Then ]  
    [ statements ]  
[ ElseIf elseifcondition [ Then ]  
    [ elseifstatements ] ]  
[ Else  
    [ elsestatements ] ]  
End If  

For more details, please refer to VBA condition syntax

Loop

For Loop simple example:

For i = 1 To 10
    Total = Total + iArray(i)
Next i

For Loop example with Step:

For d = 0 To 10 Step 0.1
    dTotal = dTotal + d
Next d

To break the for loop, use Exit For:

For i = 1 To 100
    If dValues(i) = dVal Then
        indexVal = i
        Exit For
    End If
Next i

For Each simple example:

For Each wSheet in Worksheets
    MsgBox "Found Worksheet: " & wSheet.Name
Next wSheet

For more information, please refer to Excel VBA — For Loop, For Each, and Do Loop and Excel VBA Tutorial Part 6 — VBA Loops.

References

• Build an Excel Add-In
• 如何：在功能區顯示開發人員索引標籤
• Creating VBA Add-ins to Extend and Automate Microsoft Office Documents
• Excel VBA 參考
• face ID Table
• VBA condition syntax
• how to create an Excel VBA Userform
• Excel VBA Tutorial Part 6 — VBA Loops
• Excel VBA — For Loop, For Each, and Do Loop

I’ll give it a try. Please see comments in code.

ThisWorkbook

Option Explicit
 '
 '---------------------------------------------------------------------
 ' Purpose : Call for installation as an addin if not installed
 '---------------------------------------------------------------------
 '
Private Sub Workbook_Open()

    Dim AddinTitle As String, AddinName As String
    Dim XlsName As String

    AddinTitle = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
    XlsName = AddinTitle & ".xlsm"
    AddinName = AddinTitle & ".xla"

     'check the addin's not already installed in UserLibraryPath
    If Dir(Application.UserLibraryPath & AddinName) = Empty Then
         'ask if user wants to install now
        If MsgBox("Install " & AddinTitle & _
        " as an add-in?", vbYesNo, _
        "Install?") = vbYes _
        Then
            Run "InstallAddIn"
        End If
    Else
        If ThisWorkbook.Name = XlsName Then
            Run "ReInstall"
        End If
    End If

End Sub

 '
 '---------------------------------------------------------------------
 ' Purpose : Actuate the addin, add custom controls
 '---------------------------------------------------------------------
 '
Private Sub Workbook_AddinInstall()
    Run "AddButtons"
End Sub
 '
 '---------------------------------------------------------------------
 ' Purpose : Deactivate the addin, remove custom controls
 '---------------------------------------------------------------------
 '
Private Sub Workbook_AddinUninstall()
    Run "RemoveButtons"
End Sub

Module

Option Explicit
 '
 '---------------------------------------------------------------------
 ' Purpose : Convert .xls file to .xla, move it to
 ' addins folder, and install as addin
 '---------------------------------------------------------------------
 '
Private Sub InstallAddIn()

    Dim AddinTitle As String, AddinName As String
    Dim XlsVersion As String, MessageBody As String

    With ThisWorkbook
        AddinTitle = Left(.Name, Len(.Name) - 4)
        AddinName = AddinTitle & ".xlam"
        XlsVersion = .FullName '< could be anywhere

         'check the addin's not installed in
         'UserLibraryPath (error handling)
        If Dir(Application.UserLibraryPath & AddinName) = Empty Then

            .IsAddin = True '< hide workbook window

             'move & save as .xla file
            .SaveAs Application.UserLibraryPath & AddinName, 55

             'go thru the add-ins collection to see if it's listed
            If Listed Then
                 'check this addins checkbox in the addin dialog box
                AddIns(AddinTitle).Installed = True '<--Error happening if .xlam format
            Else
                 'it's not listed (not previously installed)
                 'add it to the addins collection
                 'and check this addins checkbox
                AddIns.Add(ThisWorkbook.FullName, True) _
                .Installed = True
            End If

             'inform user...
            MessageBody = AddinTitle & " has been installed - " & _
            "to access the tools available in" & _
            vbNewLine & _
            "this addin, you will find a button in the 'Tools' " & _
            "menu for your use"
            If BooksAreOpen Then '< quit if no other books are open
                .Save
                MsgBox MessageBody & "...", , AddinTitle & _
                " Installation Status..."
            Else
                If MsgBox(MessageBody & " the" & vbNewLine & _
                "next time you open Excel." & _
                "" & vbNewLine & vbNewLine & _
                "Quit Excel?...", vbYesNo, _
                AddinTitle & " Installation Status...") = vbYes Then
                    Application.Quit
                Else
                    .Save
                End If
            End If
        End If

    End With
End Sub


'---------------------------------------------------------------------
 ' Purpose : Checks if this addin is in the addin collection
 '---------------------------------------------------------------------
 '
Private Function Listed() As Boolean

    Dim Addin As Addin, AddinTitle As String

    Listed = False
    With ThisWorkbook
        AddinTitle = Left(.Name, Len(.Name) - 4)
        For Each Addin In AddIns
            If Addin.Title = AddinTitle Then
                Listed = True
                Exit For
            End If
        Next
    End With
End Function


'---------------------------------------------------------------------
 ' Purpose : Check if any workbooks are open
 ' (this workbook & startups excepted)
 '---------------------------------------------------------------------
 '
Private Function BooksAreOpen() As Boolean
     '
    Dim Wb As Workbook, OpenBooks As String

     'get a list of open books
    For Each Wb In Workbooks
        With Wb
            If Not (.Name = ThisWorkbook.Name _
            Or .Path = Application.StartupPath) Then
                OpenBooks = OpenBooks & .Name
            End If
        End With
    Next
    If OpenBooks = Empty Then
        BooksAreOpen = False
    Else
        BooksAreOpen = True
    End If
End Function


'---------------------------------------------------------------------
 ' Purpose : Replace addin with another version if installed
 '---------------------------------------------------------------------
 '
Private Sub ReInstall()

    Dim AddinName As String

    With ThisWorkbook
        AddinName = Left(.Name, Len(.Name) - 4) & ".xla"

         'check if 'addin' is already installed
         'in UserLibraryPath (error handling)
        If Dir(Application.UserLibraryPath & AddinName) = Empty Then

             'install if no previous version exists
            Call InstallAddIn

        Else
             'delete installed version & replace with this one if ok
            If MsgBox(" The target folder already contains " & _
            "a file with the same name... " & _
            vbNewLine & vbNewLine & _
            " (That file was last modified on: " & _
            Workbooks(AddinName) _
            .BuiltinDocumentProperties("Last Save Time") & ")" & _
            vbNewLine & vbNewLine & vbNewLine & _
            " Would you like to replace the existing file with " & _
            "this one? " & _
            vbNewLine & vbNewLine & _
            " (This file was last modified on: " & _
            .BuiltinDocumentProperties("Last Save Time") & ")", _
            vbYesNo, "Add-in Is In Place - " & _
            "Confirm File Replacemant...") = vbYes Then
                Workbooks(AddinName).Close False
                Kill Application.UserLibraryPath & AddinName
                Call InstallAddIn
            End If
        End If
    End With
End Sub

 '---------------------------------------------------------------------
 ' Purpose : Convert .xla file to .xls format
 ' and move it to default file path
 '---------------------------------------------------------------------
 '
Private Sub RemoveAddIn()

    Dim AddinTitle As String, AddinName As String
    Dim XlaVersion As String

    Application.ScreenUpdating = False

    With ThisWorkbook
        AddinTitle = Left(.Name, Len(.Name) - 4)
        AddinName = AddinTitle & ".xla"
        XlaVersion = .FullName

         'check the 'addin' is not already removed
         'from UserLibraryPath (error handling)
        If Not Dir(Application.UserLibraryPath & AddinName) = Empty _
        Then

            .Sheets(1).Cells.ClearContents '< cleanup
            Call RemoveButtons

             'move & save as .xls file
            .SaveAs Application.DefaultFilePath & _
            "" & AddinTitle & ".xls"

            Kill XlaVersion '< delete .xla version

             'uncheck checkbox in the addin dialog box
            AddIns(AddinTitle).Installed = False
            .IsAddin = False '< show workbook window
            .Save

             'inform user and close
            MsgBox "The addin '" & AddinTitle & "' has been " & _
            "removed and converted to an .xls file." & _
            vbNewLine & vbNewLine & _
            "Should you later wish to re-install this as " & _
            "an addin, open the .xls file which" & _
            vbNewLine & "can now be found in " & _
            Application.DefaultFilePath & _
            " as: '" & .Name & "'"
            .Close
        End If

    End With

    Application.ScreenUpdating = True
End Sub


'---------------------------------------------------------------------
 ' Purpose : Add addin control buttons
 '---------------------------------------------------------------------
 '
Private Sub AddButtons()

     'change 'Startups...' to suit
    Const MyControl As String = "Startups..."
     'change 'Manage Startups' to suit
    Const MyControlCaption As String = "Manage Startups"

    Dim AddinTitle As String, Mybar As Object

    AddinTitle = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)

    Call RemoveButtons

    On Error GoTo ErrHandler
    Set Mybar = Application.CommandBars("Worksheet Menu Bar") _
    .Controls("Tools").Controls _
    .Add(Type:=msoControlPopup, before:=13)
     '
    With Mybar
        .BeginGroup = True
        .Caption = MyControl
         '-------------------------------------------------------------
        .Controls.Add.Caption = MyControlCaption
        .Controls(MyControlCaption).OnAction = "ShowStartupForm"
         '-------------------------------------------------------------
        With .Controls.Add
            .BeginGroup = True
            .Caption = "Case " & AddinTitle
        End With
        .Controls("Case change " & AddinTitle).OnAction = "ULCase.UpperMacro"
         '-------------------------------------------------------------
        .Controls.Add.Caption = "Remove " & AddinTitle
        .Controls("Remove " & AddinTitle).OnAction = "Module1.RemoveAddIn"
         '-------------------------------------------------------------
    End With
    Exit Sub

ErrHandler:
    Set Mybar = Nothing
    Set Mybar = Application.CommandBars("Tools") _
    .Controls.Add(Type:=msoControlPopup, before:=13)
    Resume Next
End Sub
 '
 '---------------------------------------------------------------------
 ' Purpose : Remove addin control buttons
 '---------------------------------------------------------------------
 '
Private Sub RemoveButtons()
     '
     'change 'Startups...' to suit
    Const MyControl As String = "Startups..."
    On Error Resume Next
    With Application
        .CommandBars("Tools").Controls(MyControl).Delete
        .CommandBars("Worksheet Menu Bar") _
        .Controls("Tools").Controls(MyControl).Delete
    End With
End Sub