VBA TIPS
Making a custom CommandBar

The following procedure makes a custom CommandBar.

When adding CommandBars, an error occurs if the same name is already added, so it would be better to delete in advance as follows. (Please have a look at Private Sub DelteMyCommandBar())



Example

Place the following in a standard module.

To get FaceID, use FaceId Explorer at http://officeone.mvps.org/faceid/. Copyright© OfficeOne

Option Explicit

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'API code for module named About
Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hWnd As Long, _
                                                                   ByVal szApp As String, _
                                                                   ByVal szOtherStuff As String, _
                                                                   ByVal hIcon As LongAs Long
Declare Function GetActiveWindow Lib "user32" () As Long
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

'the name of a command bar
Const sCmbName As String = "Create a sample cmb"


Private Sub Auto_Open()
    'Make a commandbar when this workbook is opened
    CreateMyCommandBar
End Sub


Private Sub Auto_Close()
    'Delete a commandbar when this workbook is closed
    DelteMyCommandBar
End Sub


Private Sub CreateMyCommandBar()

    Dim ocb As CommandBar

    'reset/delete a previous custom menu before create a new custom menu
    Call DelteMyCommandBar

    '-about arguments
    'Position:=0 'position would NOT be fixed
    'Position:=1 'position would be fixed
    'if set as Temporary:=True, this commandbar will be deleted when
    'Excel is closed.
    Set ocb = CommandBars.Add(Name:=sCmbName, Position:=1, Temporary:=True)

    With ocb

    'Disanle X button
        .Protection = msoBarNoChangeVisible

    'add a combobox to a commandbar
        .Controls.Add Type:=msoControlComboBox
        With .Controls(1)
            .Caption = "Select value"
            .BeginGroup = False
            'add elements to the combobox
            .AddItem "element1"
            .AddItem "element2"
            .AddItem "element3"
        End With

    'add a ControlButton to a commandbar
        .Controls.Add Type:=msoControlButton
        With .Controls(2)
            .Caption = "View selected value"
            .OnAction = "Test"
            .FaceId = 2892
            .BeginGroup = False
        End With

    'add a ControlButton to a commandbar
        .Controls.Add Type:=msoControlButton
        With .Controls(3)
            .Caption = "About..."
            .OnAction = "About"
            .FaceId = 487
            .BeginGroup = True
        End With

        'don't forget this!
        .Visible = True

    End With
End Sub


Private Sub DelteMyCommandBar()
    On Error Resume Next
    Application.CommandBars(sCmbName).Delete
    On Error GoTo 0
End Sub


Sub Test()
    With Application.CommandBars(sCmbName).Controls("Select value")
        If .Text = "" Then
            MsgBox "not selected any value"
        Else
            MsgBox .Text
        End If
    End With
End Sub


Sub About()
    Dim hWnd As Integer
    On Error Resume Next
    hWnd = GetActiveWindow()
    ShellAbout hWnd, sCmbName, vbCrLf + Chr(169) + _
                               "" & "Colo's Excel Junk Room" + vbCrLf, 0
    On Error GoTo 0
End Sub




| HOME |
Copyright © cellmasters.net - colo's junk room All Right Reserved
ABOUT
WORKS
THE CELL MASTERS
CONTACT
LINKS
Tips and Information about Microsoft Excel|Masaru Kaji aka Colo