VBA Snippets

Clipboard_Empty

Public Sub Clipboard_Empty()
   On Error GoTo AnError
   Dim oData As New MSForms.DataObject
   oData.SetText Text:=Empty
   oData.PutInClipboard
   
   If gbDEBUG_ERRMSG = False Then Exit Function
AnError:
   Call Error_Handle("Clipboard_Empty", msMODULENAME, _
        " .")
End Sub

CmdBar_ButtonAdd

Public Function CmdBar_ButtonAdd(ByVal sBarName As String, _
                                 ByVal sButtonCaption As String, _
                                 ByVal sParameterName As String, _
                                 ByVal sTagText As String, _
                                 ByVal sOnActionText As String, _
                        Optional ByVal sToolTipText As String = "", _
                        Optional ByVal bBeginGroup As Boolean = False, _
                        Optional ByVal bPasteFace As Boolean = False, _
                        Optional ByVal lFaceIdNo As Long = 0, _
                        Optional ByVal iButtonWidth As Integer = 10, _
                        Optional ByVal bSelected As Boolean = False, _
                        Optional ByVal bTemporary As Boolean = False) _
                                    As Office.CommandBarButton
    On Error GoTo AnError
    Dim objbutton As Office.CommandBarButton
    Set objbutton = CommandBars.Item(sBarName).Controls.Add( _
                      Type:=Office.MsoControlType.msoControlButton, _
                      Temporary:=bTemporary, _
                      Parameter:=sParameterName)
    With objbutton
        If (bPasteFace = False And lFaceIdNo = 0) Then _
            .Style = Office.MsoButtonStyle.msoButtonCaption
        If (bPasteFace = True Or lFaceIdNo > 0) Then _
            .Style = Office.MsoButtonStyle.msoButtonIconAndCaption
        .Tag = sTagText
        .OnAction = sOnActionText
        .Caption = sButtonCaption
        .TooltipText = sToolTipText
        .BeginGroup = bBeginGroup
        .Width = iButtonWidth
        If bPasteFace = False And lFaceIdNo > 0 Then .FaceId = lFaceIdNo
        If bPasteFace = True Then
            .PasteFace
        End If
        If bSelected = True Then _
            .State = Office.MsoButtonState.msoButtonDown
        If bSelected = False Then _
            .State = Office.MsoButtonState.msoButtonUp
    End With
    Set CmdBar_ButtonAdd = objbutton
    If gbDEBUG_ERRMSG = False Then Exit Function
AnError:
    Call Error_Handle("CmdBar_ButtonAdd", msMODULENAME, _
        "add the button with the caption '" & sButtonCaption & "'" & _
        vbCrLf & "and the parameter '" & sParameterName & "'" & _
        vbCrLf & "to the command bar called '" & sBarName & "'.")
End Function

CmdBar_ComboAdd

Adds a combo box to a command bar. Populating the combo box must be done afterwards.

Public Function CmdBar_ComboAdd(ByVal sBarName As String, _
                                ByVal sParameterName As String, _
                                ByVal sTagText As String, _
                                ByVal sOnActionText As String, _
                       Optional ByVal iComboBoxWidth As Integer = 50, _
                       Optional ByVal sToolTipText As String = "", _
                       Optional ByVal bBeginGroup As Boolean = False, _
                       Optional ByVal iNumberofDropLines As Integer = 10, _
                       Optional ByVal bTemporary As Boolean = False) _
                                As Office.CommandBarComboBox

    On Error GoTo AnError
    Dim objcombobox As Office.CommandBarComboBox
    Dim objtemporary As Office.MsoTriState

    If bTemporary = True Then objtemporary = Office.MsoTriState.msoTrue
    If bTemporary = False Then objtemporary = Office.MsoTriState.msoFalse
    Set objcombobox = CommandBars.Item(sBarName).Controls.Add( _
                        Type:=Office.MsoControlType.msoControlComboBox, _
                        Temporary:=objtemporary, _
                        Parameter:=sParameterName)
    With objcombobox
        .Tag = sTagText
        .OnAction = sOnActionText
        .Width = iComboBoxWidth
        .TooltipText = sToolTipText
        .BeginGroup = bBeginGroup
        .DropDownLines = iNumberofDropLines
        .ListIndex = 0
    End With
    Set CmdBar_ComboAdd = objcombobox

    If gbDEBUG_ERRMSG = False Then Exit Function
AnError:
    Call Error_Handle("CmdBar_ComboAdd", msMODULENAME, _
         "add the combo box '" & sParameterName & "' with the macro " & _
         "to the command bar called '" & sBarName & "'.")
End Function

CmdBar_ComboAddFiles

Adds all the files in a particular folder to a combo box on a command bar.

Public Sub CmdBar_ComboAddFiles(ByVal sBarName As String, _
                                ByVal sComboBoxName As String, _
                                ByVal sFolderPath As String, _
                                ByVal sExtension As String)
Dim FileNameCombo As CommandBarComboBox
Dim FolderNameCombo As CommandBarComboBox
Dim sFolderPath As String
Dim snextfile As String
   On Error GoTo AnError
   Set FolderNameCombo = CommandBars.Item(sBarName).Controls(iCtrlNoFolderPath)
   sFolderPath = FolderNameCombo.List(FolderNameCombo.ListIndex)
   Set FileNameCombo = CommandBars.Item(sBarName).Controls(iCtrlNoFileName)
   FileNameCombo.Clear
   snextfile = Dir(sFolderPath & "\" & sExtension)
   Do While snextfile <> ""
      FileNameCombo.AddItem Text:=snextfile
      snextfile = Dir
   Loop
   If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
   Call Error_Handle("CmdBar_ComboAddFiles", msMODULENAME, 1, _
        "add all the files in the folder" & vbCrLf & sFolderPath & vbCrLf & _
        " to the combo box " & sComboBoxName & """")
End Sub

CmdBar_ComboAddString

Adds all the items from a string concatenation to a combo box on a command bar.

Public Sub CmdBar_ComboAddString(ByVal sBarName As String, _
                                 ByVal sComboBoxParameter As String, _
                                 ByVal sText As String, _
                        Optional ByVal sSeparateChar As String = ";")

    On Error GoTo AnError
    Dim objcombobox As Office.CommandBarComboBox
    Dim iindex As Integer
    Dim snextentry As String

    With CommandBars.Item(sBarName)
        For iindex = 1 To .Controls.Count
            If .Controls(iindex).Parameter = sComboBoxParameter Then _
                Set objcombobox = .Controls(iindex)
        Next iindex
        objcombobox.Clear
    End With

    Do While Len(sText) > 0
        If InStr(1, sText, sSeparateChar) = 0 Then
            snextentry = sText
            sText = ""
        Else
            snextentry = Left(sText, InStr(1, sText, sSeparateChar) - 1)
            sText = Right(sText, Len(sText) - Len(snextentry) - 1)
        End If
        objcombobox.AddItem Text:=snextentry
    Loop

    If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
    Call Error_Handle("CmdBar_AddString", msMODULENAME, _
         "add the string concatenation " & vbCrLf & _
         """" & sText & """" & vbCrLf & vbCrLf & _
         "to the combo box with parameter """ & sComboBoxParameter & """")
End Sub

CmdBar_ComboClear

Removes all the items in the combobox on a command bar.

Public Sub CmdBar_ComboClear(ByVal sBarName As String, _
                             ByVal iFolderNameCtrlNo As Integer)
Dim DirectoryNameCombo As CommandBarComboBox
Dim spath As String
Dim snextentry As String
   On Error GoTo AnError
   Set DirectoryNameCombo = CommandBars.Item(sBarName).Controls(iFolderNameCtrlNo)
   DirectoryNameCombo.Clear                                  'clears any previous entries
   
   Set DirectoryNameCombo = Nothing
   If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
   Call Error_Handle("CmdBar_ComboClear", msMODULENAME, 1, _
        "")
End Sub

CmdBar_ComboSelectionGet

Returns the currently selected item in a combobox on a command bar Make sure that it returns the current selection.

Public Function CmdBar_ComboSelectionGet(ByVal sBarName As String, _
                                         ByVal sComboBoxParameter As String) _
                                         As String

    On Error GoTo AnError
    Dim objcombobox As Office.CommandBarComboBox
    Dim iindex As Integer

    With CommandBars.Item(sBarName)
        For iindex = 1 To .Controls.Count
            If .Controls(iindex).Parameter = sComboBoxParameter Then _
                Set objcombobox = .Controls(iindex)
        Next iindex
    End With

    CmdBar_ComboSelectionGet = objcombobox.Text

    If gbDEBUG_ERRMSG = False Then Exit Function
AnError:
    Call Error_Handle("CmdBar_ComboSelectionGet", msMODULENAME, _
         "return the selection that has been made in the combo box " & _
         "with parameter '" & sComboBoxParameter & "' " & _
         "on the command bar called '" & sBarName & "'.")
End Function

CmdBar_ComboSelectionSet

Sets the currently selected item in a combobox. This is set to the matching item that is passed in. What if it doesn't match ?? TEST.

Public Sub CmdBar_ComboSelectionSet(ByVal sBarName As String, _
                                    ByVal sComboBoxParameter As String, _
                                    ByVal sMatchItem As String, _
                           Optional ByVal bInformUser As Boolean = True, _
                           Optional ByVal iComboBoxCtrlNo As Integer = 0)

    On Error GoTo AnError
    Dim objcombobox As Office.CommandBarComboBox
    Dim iindex As Integer
    Dim bfoundmatch As Boolean

    With CommandBars.Item(sBarName)
        For iindex = 1 To .Controls.Count
            If .Controls(iindex).Parameter = sComboBoxParameter Then _
                Set objcombobox = .Controls(iindex)
        Next iindex
    End With

    bfoundmatch = False
    For iindex = 1 To objcombobox.ListCount
        If objcombobox.List(iindex) = sMatchItem Then
            bfoundmatch = True
            objcombobox.ListIndex = iindex
            Exit Sub
        End If
    Next iindex

    If bfoundmatch = False Then
        Call MsgBox("The item """ & sMatchItem & """ is not in the combo box " & _
                    " with parameter """ & sComboBoxParameter & """" & _
                    " on the command bar """ & sBarName & """", _
                    VBA.VbMsgBoxStyle.vbInformation)
    End If

    If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
    Call Error_Handle("CmdBar_ComboSelectionSet", msMODULENAME, 1, _
         "set the selection in the combo box with parameter '" & sComboBoxParameter & "'" & _
         " to '" & sMatchItem & "' on the toolbar called '" & sBarName & "'.")
End Sub

CmdBar_ControlAdd

Public Sub CmdBar_ControlAdd(ByVal sBarName As String, _
                             ByVal iControlID As Integer, _
                    Optional ByVal iFaceID As Integer = 0, _
                    Optional ByVal sButtonCaption As String = "", _
                    Optional ByVal bBeginGroup As Boolean = False, _
                    Optional ByVal bTemporary As Boolean = False)
   On Error GoTo AnError
   Dim objcontrol As Office.CommandBarButton
    
   Set objcontrol = CommandBars.Item(sBarName).Controls.Add( _
                                     Temporary:=bTemporary, _
                                     ID:=iControlID)
   
   If iFaceID > 0 Then
      objcontrol.FaceId = iFaceID
   End If
   
   If Len(sButtonCaption) > 0 Then
      objcontrol.Caption = sButtonCaption
   End If
   
   objcontrol.BeginGroup = bBeginGroup
   
   Set objcontrol = Nothing
    
   If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
   Call Error_Handle("CmdBar_ControlAdd", msMODULENAME, _
       "add the control with ID '" & iControlID & "'" & _
       vbCrLf & "on the command bar called '" & sBarName & "'.")
End Sub

CmdBar_ControlDelete

Removes a control from a given command bar. The type of the control must be ????.

Public Sub CmdBar_ControlDelete(ByVal sBarName As String, _
                                ByVal vMSOControlType As Variant, _
                                ByVal sControlName As String, _
                       Optional ByVal iControlNo As Integer = 0)
                       
Dim barcontrol As CommandBarControl
Dim serrortext As String
   On Error GoTo AnError
   Set barcontrol = CommandBars.Item(sBarName).FindControl(vMSOControlType, sControlName)
   If sControlName = "" Then _
      Set barcontrol = CommandBars.Item(sBarName).Controls.Item(iControlNo)
   barcontrol.Delete
   If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
   If sControlName = "" Then _
      serrortext = CommandBars.Item(sBarName).Controls(iControlNo).Name
   If sControlName = "" Then serrortext = "control """ & serrortext & """"
   If iControlNo = 0 Then serrortext = "the control number " & iControlNo

   Call Error_Handle("CmdBar_ControlDelete", msMODULENAME, 1, _
        "delete the control '" & sControlName & "'" & _
        " on the command bar called '" & sBarName & "'.")
End Sub

CmdBar_ControlEnabled

Enables or disables a control on a command bar.

Public Sub CmdBar_ControlEnabled(ByVal bEnable As Boolean, _
                                 ByVal vMSOControlType As Variant, _
                                 ByVal sBarName As String, _
                                 ByVal sControlName As String, _
                        Optional ByVal iControlNo As Integer = 0)

   On Error GoTo AnError
   With CommandBars.Item(sBarName)
      If iControlNo = 0 Then _
         .FindControl(vMSOControlType, sControlName).Enabled = bEnable
      If sControlName = "" Then _
         .Controls.Item(iControlNo).Enabled = bEnable
   End With
   If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
   Call Error_Handle("CmdBar_ControlEnabled", msMODULENAME, 1, _
        bEnable & " the control '" & sControlName & "'" & _
        " on the command bar called '" & sBarName & "'.")
End Sub

CmdBar_ControlExists

Determines if a particular control exists on a command bar. Returns True or False.

Public Function CmdBar_ControlExists(ByVal sBarName As String, _
                                     ByVal sControlName As String, _
                            Optional ByVal iControlNo As Integer = -1) As Boolean
   On Error GoTo AnError


   If gbDEBUG_ERRMSG = False Then Exit Function
AnError:
   Call Error_Handle("CmdBar_ControlExists", msMODULENAME, 1, _
        "determine if the control exists """ & sControlName & """" & _
        " on the command bar called """ & sBarName & """")
End Function

CmdBar_ControlFaceIDChange

Public Sub CmdBar_ControlFaceIDChange(ByVal sBarName As String, _
                                      ByVal sControlCaption As String, _
                                      ByVal lFaceIDNo As Long)
                                   
    On Error GoTo AnError
    Dim objbutton As Office.CommandBarButton
    
    Dim icontrolno As Integer

   With CommandBars(sBarName)
      If Len(sControlCaption) > 0 Then
         For icontrolno = 1 To .Controls.Count
            If .Controls(icontrolno).Caption = sControlCaption Then
               objbutton = .Controls(icontrolno)
               Exit For
            End If
         Next icontrolno
      End If
   End With

    objbutton.FaceId = lFaceIDNo

    If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
    Call Error_Handle("CmdBar_ControlFaceIDChange", msMODULENAME, _
        "change the face ID on the control with " & vbCrLf & _
        "Caption: " & sControlCaption & vbCrLf & _
        vbCrLf & "on the command bar called '" & sBarName & "'.")
End Sub

CmdBar_ControlName

Returns the name of the control that is in a given position on a command bar.

Public Function CmdBar_ControlName(ByVal sBarName As String, _
                                   ByVal iControlNo As Integer) As String
   On Error GoTo AnError
   CmdBar_ControlName = CommandBars.Item(sBarName).Controls(iControlNo).Name
   If gbDEBUG_ERRMSG = False Then Exit Function
AnError:
   Call Error_Handle("CmdBar_ControlName", msMODULENAME, 1, _
        "return the name of control number '" & iControlNo & "'" & _
        " on the command bar called '" & sBarName & "'.")
End Function

CmdBar_ControlsDelete

Public Sub CmdBar_ControlsDelete(ByVal sBarName As String)
    On Error GoTo AnError
    Dim icontrolcount As Integer
    For icontrolcount = 1 To CommandBars.Item(sBarName).Controls.Count
        CommandBars.Item(sBarName).Controls(1).Delete
    Next icontrolcount
    If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
    Call Error_Handle("CmdBar_ControlsDelete", msMODULENAME, _
         "delete all the controls on the command bar called '" & sBarName & "'.")
End Sub

CmdBar_Create

Creates a new command bar.

Public Sub CmdBar_Create(ByVal sFloatingOrDocked As String, _
                         ByVal sBarName As String, _
                Optional ByVal bIsItVisible As Boolean = True)

   On Error GoTo AnError
   Dim commandsBarName As Office.CommandBar
   
   If CmdBar_Exists(sBarName) = True Then
       Call MsgBox("The toolbar '" & sBarName & "' already exists." & vbCrLf & _
                   "The existing one will be deleted !!", VBA.VbMsgBoxStyle.vbInformation)
       Call CmdBar_Delete(sBarName)
   End If
    
   If sFloatingOrDocked = "Floating" Then
          Set commandsBarName = CommandBars.Add( _
             name:=sBarName, _
             Position:=Office.MsoBarPosition.msoBarFloating, _
             MenuBar:=False, _
             Temporary:=True)
   End If
   
   If sFloatingOrDocked = "Docked" Then
          Set commandsBarName = CommandBars.Add( _
             name:=sBarName, _
             Position:=Office.MsoBarPosition.msoBarTop, _
             MenuBar:=False, _
             Temporary:=True)
   End If
   commandsBarName.Visible = bIsItVisible
   commandsBarName.Protection = Office.MsoBarProtection.msoBarNoCustomize + _
                                Office.MsoBarProtection.msoBarNoResize

   If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
   Call Error_Handle("CmdBar_Create", msMODULENAME, _
        "create the command bar called '" & sBarName & "'.")
End Sub

CmdBar_Delete

Deletes a command bar.

Public Sub CmdBar_Delete(ByVal sBarName As String, _
                Optional ByVal bJustControls As Boolean = False, _
                Optional ByVal bInformUser As Boolean = True)

    On Error GoTo AnError
    Dim commandsBarName As Office.CommandBar

    commandsBarName = CmdBar_Get(sBarName)
    If commandsBarName Is Nothing Then
        If bInformUser = True Then _
           Call MsgBox("The toolbar '" & sBarName & "' has already been deleted", _
                       VBA.VbMsgBoxStyle.vbInformation)
    Else
        If bJustControls = False Then
            commandsBarName.Delete
        Else
            Call CmdBar_ControlsDelete(sBarName)
        End If
    End If

    If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
    Call Error_Handle("CmdBar_Delete", msMODULENAME, _
         "delete the command bar called '" & sBarName & "'.")
End Sub

CmdBar_DropDownAdd

Adds a drop-down menu to a command bar.

Public Sub CmdBar_DropDownAdd(ByVal sBarName As String, _
                              ByVal sTagText As String, _
                              ByVal sDropDownCaption As String, _
                     Optional ByVal iDropDownWidth As Integer = 50, _
                     Optional ByVal sToolTipText As String = "", _
                     Optional ByVal bBeginGroup As Boolean = False, _
                     Optional ByVal bTemporary As Boolean = False, _
                     Optional ByVal iBeforeControl As Integer = -1)

    On Error GoTo AnError
    Dim objdropdownbar As CommandBarPopup
    Dim objtemporary As MsoTriState

    If bTemporary = True Then objtemporary = MsoTriState.msoTrue
    If bTemporary = False Then objtemporary = MsoTriState.msoFalse
    
    If iBeforeControl > -1 Then
       Set objdropdownbar = CommandBars.Item(sBarName).Controls.Add( _
                                        Type:=MsoControlType.msoControlPopup, _
                                        Before:=iBeforeControl, _
                                        Temporary:=objtemporary)
    Else
      Set objdropdownbar = CommandBars.Item(sBarName).Controls.Add( _
                                       Type:=MsoControlType.msoControlPopup, _
                                       Temporary:=objtemporary)
    End If
                               
    With objdropdownbar
        .Tag = sTagText
        .Caption = sDropDownCaption
        .Width = iDropDownWidth
        .TooltipText = sToolTipText
        .BeginGroup = bBeginGroup
    End With

    If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
    Call Error_Handle("CmdBar_DropDownAdd", msMODULENAME, _
         "add the drop-down menu with the tag '" & sTagText & "'" & _
         " to the command bar called '" & sBarName & "'.")
End Sub

CmdBar_DropDownButtonAdd

Adds a button to a drop-down menu on a command bar. The default button state is up.

Public Function CmdBar_DropDownButtonAdd(ByVal sBarName As String, _
                                         ByVal sDropDownTag As String, _
                                         ByVal sDropDownCaption As String, _
                                         ByVal sButtonCaption As String, _
                                         ByVal sParameterName As String, _
                                         ByVal sTagText As String, _
                                         ByVal sOnActionText As String, _
                                Optional ByVal sToolTipText As String = "", _
                                Optional ByVal bBeginGroup As Boolean = False, _
                                Optional ByVal bPasteFace As Boolean = False, _
                                Optional ByVal lFaceIdNo As Long = 1, _
                                Optional ByVal bButtonState As String = "UP", _
                                Optional ByVal bTemporary As Boolean = False) _
                                         As CommandBarButton

Dim objdropdownbar As CommandBarPopup
Dim objbutton As CommandBarButton
Dim objtemporary As MsoTriState

   On Error GoTo AnError
      
   If bTemporary = True Then objtemporary = MsoTriState.msoTrue
   If bTemporary = False Then objtemporary = MsoTriState.msoFalse
       
   Set objdropdownbar = CmdBar_FindDropDownReturn(sBarName, -1, sDropDownCaption, sDropDownTag)

   Set objbutton = objdropdownbar.Controls.Add( _
                     Type:=Office.MsoControlType.msoControlButton, _
                     Temporary:=objtemporary, _
                     Parameter:=sParameterName)

   With objbutton
       .Style = MsoButtonStyle.msoButtonIconAndCaption
       .Tag = sTagText
       .OnAction = sOnActionText
       .Caption = sButtonCaption
       .TooltipText = sToolTipText
       .BeginGroup = bBeginGroup
       If bPasteFace = False Then .FaceId = lFaceIdNo
       If bPasteFace = True Then .PasteFace
       If bButtonState = "DOWN" Then .State = MsoButtonState.msoButtonDown
   End With
   Set CmdBar_DropDownButtonAdd = objbutton
    
   If gbDEBUG_ERRMSG = False Then Exit Function
AnError:
   Call Error_Handle("CmdBar_DropDownButtonAdd", msMODULENAME, _
        "add the button with:" & vbCrLf & _
        "parameter '" & sParameterName & "'" & vbCrLf & _
        "to the drop-down menu with:" & _
        "tag '" & sTagText & "'" & vbCrLf & _
        "to the command bar called '" & sBarName & "'.")
End Function

CmdBar_DropDownButtonCaptionGet

Returns the caption on a button on a drop-down menu on a command bar.

Public Function CmdBar_DropDownButtonCaptionGet(ByVal sBarName As String, _
                                                ByVal sDropDownName As String, _
                                                ByVal sButtonName As String, _
                                       Optional ByVal iDropDownCtrlNo As Integer = 0, _
                                       Optional ByVal iButtonCtrlNo As Integer = 0) As String
Dim dropdownbar As CommandBarPopup
Dim dropdownbarbutton As CommandBarControl
Dim serrortext As String
   On Error GoTo AnError
   With CommandBars.Item(sBarName)
      If iDropDownCtrlNo = 0 Then _
         Set dropdownbar = .FindControl(msoControlPopup, sDropDownName)
      If sDropDownName = "" Then _
         Set dropdownbar = .Controls.Item(iDropDownCtrlNo)
   End With
   If sButtonName = "" Then _
      CmdBar_DropDownButtonCaptionGet = _
         dropdownbar.Controls.Item(iButtonCtrlNo).Caption
   If iButtonCtrlNo = 0 Then _
      CmdBar_DropDownButtonCaptionGet = _
         dropdownbar.Controls.Item(sButtonName).Caption
        
   If gbDEBUG_ERRMSG = False Then Exit Function
AnError:
   If sButtonName = "" Then _
      serrortext = dropdownbar.Controls.Item(iButtonCtrlNo).Name & " on the "
   If sButtonName = "" Then serrortext = "the control number " & iDropDownCtrlNo
   If iButtonCtrlNo = 0 Then serrortext = "button """ & sButtonName & """ on the "
   If sDropDownName = "" Then _
      serrortext = serrortext & CommandBars.Item(sBarName).Controls(iDropDownCtrlNo).Name
   If sDropDownName = "" Then serrortext = "the control number " & iDropDownCtrlNo
   If iDropDownCtrlNo = 0 Then serrortext = "dropdown """ & sDropDownName & """"
   
   Call Error_Handle("CmdBar_DropDownButtonCaptionGet", msMODULENAME, 1, _
        "return the caption on the " & serrortext & " to """ & sButtonName & _
        """ on the command bar called """ & sBarName & """")
End Function

CmdBar_DropDownButtonCaptionSet

Sets the caption on a button on a drop-down menu on a command bar.

Public Sub CmdBar_DropDownButtonCaptionSet(ByVal sBarName As String, _
                                           ByVal sDropDownName As String, _
                                           ByVal sButtonName As String, _
                                           ByVal sButtonCaptionNew As String, _
                                  Optional ByVal iDropDownCtrlNo As Integer = 0, _
                                  Optional ByVal iButtonCtrlNo As Integer = 0)
Dim dropdownbar As CommandBarPopup
Dim dropdownbarbutton As CommandBarControl
Dim serrortext As String
   On Error GoTo AnError
   If iDropDownCtrlNo = 0 Then _
      Set dropdownbar = CommandBars.Item(sBarName) _
                        .FindControl(msoControlPopup, sDropDownName)
   If sDropDownName = "" Then _
      Set dropdownbar = CommandBars.Item(sBarName).Controls.Item(iDropDownCtrlNo)

   If sButtonName = "" Then _
      dropdownbar.Controls.Item(iButtonCtrlNo).Caption = sButtonCaptionNew
   If iButtonCtrlNo = 0 Then _
      dropdownbar.Controls.Item(sButtonName).Caption = sButtonCaptionNew
        
   If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
   If sButtonName = "" Then _
      serrortext = dropdownbar.Controls.Item(iButtonCtrlNo).Name & " on the "
   If sButtonName = "" Then serrortext = "the control number " & iDropDownCtrlNo
   If iButtonCtrlNo = 0 Then serrortext = "button """ & sButtonName & """ on the "
   If sDropDownName = "" Then _
      serrortext = serrortext & CommandBars.Item(sBarName).Controls(iDropDownCtrlNo).Name
   If sDropDownName = "" Then serrortext = "the control number " & iDropDownCtrlNo
   If iDropDownCtrlNo = 0 Then serrortext = "dropdown """ & sDropDownName & """"
   
   Call Error_Handle("CmdBar_DropDownButtonCaptionSet", msMODULENAME, 1, _
        "change the caption on the " & serrortext & " to """ & sButtonCaptionNew & _
        """ on the toolbar called """ & sBarName & """")
End Sub

CmdBar_DropDownCheckBoxAdd

Adds a checkbox button to a drop-down menu on a command bar. The checkbox is not selected by default.

Public Function CmdBar_DropDownCheckboxAdd(ByVal sBarName As String, _
                                           ByVal sDropDownTag As String, _
                                           ByVal sCheckBoxCaption As String, _
                                           ByVal sParameterName As String, _
                                           ByVal sOnActionText As String, _
                                  Optional ByVal bSelected As Boolean = False, _
                                  Optional ByVal sToolTipText As String = "", _
                                  Optional ByVal bBeginGroup As Boolean = False, _
                                  Optional ByVal lFaceIdNo As Long = 1, _
                                  Optional ByVal bTemporary As Boolean = False) _
                                           As Office.CommandBarButton

    On Error GoTo AnError
    Dim objdropdownbar As Office.CommandBarPopup
    Dim objbutton As Office.CommandBarButton
    Dim objtemporary As Office.MsoTriState

    If bTemporary = True Then objtemporary = Office.MsoTriState.msoTrue
    If bTemporary = False Then objtemporary = Office.MsoTriState.msoFalse

    Set objdropdownbar = CommandBars.Item(sBarName).FindControl(Tag:=sDropDownTag)

    Set objbutton = objdropdownbar.Controls.Add( _
                      Type:=Office.MsoControlType.msoControlButton, _
                      Temporary:=objtemporary, _
                      Parameter:=sParameterName)

    With objbutton
        .Style = Office.MsoButtonStyle.msoButtonIconAndCaption
        .Caption = sCheckBoxCaption
        .OnAction = sOnActionText
        .TooltipText = sToolTipText
        .BeginGroup = bBeginGroup
        If lFaceIdNo = 0 Then
            If bSelected = True Then .FaceId = giCHECKBOX_FACEID
            If bSelected = True Then .State = Office.MsoButtonState.msoButtonDown
            If bSelected = False Then .FaceId = 1
            If bSelected = False Then .State = Office.MsoButtonState.msoButtonUp
        Else
            .FaceId = iFaceIdNo
        End If
    End With
    CmdBar_DropDownCheckboxAdd = objbutton

    If gbDEBUG_ERRMSG = False Then Exit Function
AnError:
    Call Error_Handle("CmdBar_DropDownCheckboxAdd", msMODULENAME, 1, _
         "add a checkbox called '" & sParameterName & "'" & vbCrLf & _
         "with the caption '" & sCheckBoxCaption & "'" & vbCrLf & _
         "to the drop-down menu '" & sDropDownTag & "'" & vbCrLf & _
         "to the command bar called '" & sBarName & "'.")
End Function

CmdBar_DropDownCheckBoxChange

Selects or deselects the checkbox button on a drop-down menu on a command bar.

Public Sub CmdBar_DropDownCheckboxChange(ByVal sBarName As String, _
                                         ByVal sDropDownTag As String, _
                                         ByVal sCheckBoxParameter As String, _
                                         ByVal bSelected As Boolean)

    On Error GoTo AnError
    Dim objdropdownbar As Microsoft.Office.Core.CommandBarPopup
    Dim objbutton As Microsoft.Office.Core.CommandBarButton
    Dim iindex As Integer

    objdropdownbar = CType(gApplication.CommandBars.Item(sBarName).FindControl(Tag:=sDropDownTag), _
                           Microsoft.Office.Core.CommandBarPopup)

    For iindex = 1 To objdropdownbar.Controls.Count
        If objdropdownbar.Controls(iindex).Parameter = sCheckBoxParameter Then _
            objbutton = CType(objdropdownbar.Controls(iindex), Microsoft.Office.Core.CommandBarButton)
    Next iindex

    If bSelected = True Then objbutton.FaceId = giCHECKBOX_FACEID
    If bSelected = True Then objbutton.State = Microsoft.Office.Core.MsoButtonState.msoButtonDown
    If bSelected = False Then objbutton.FaceId = 1
    If bSelected = False Then objbutton.State = Microsoft.Office.Core.MsoButtonState.msoButtonUp

    If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
    Call Error_Handle("CmdBar_DropDownCheckboxChange", msMODULENAME, 1, _
         "change the checkbox with parameter """ & sCheckBoxParameter & """" & _
         " on the drop-down menu with tag """ & sDropDownTag & """" & _
         " on the command bar called """ & sBarName & """")
End Sub

CmdBar_DropDownCheckBoxToggle

Toggles the checkbox button on a drop-down menu on a command bar.

Public Sub CmdBar_DropDownCheckboxToggle(ByVal sBarName As String, _
                                         ByVal sDropDownTag As String, _
                                         ByVal sCheckBoxParameter As String)

    On Error GoTo AnError
    Dim objdropdownbar As Microsoft.Office.Core.CommandBarPopup
    Dim objbutton As Microsoft.Office.Core.CommandBarButton
    Dim iindex As Integer

    objdropdownbar = CType(gApplication.CommandBars.Item(sBarName).FindControl(Tag:=sDropDownTag), _
                           Microsoft.Office.Core.CommandBarPopup)

    For iindex = 1 To objdropdownbar.Controls.Count
        If objdropdownbar.Controls(iindex).Parameter = sCheckBoxParameter Then _
            objbutton = CType(objdropdownbar.Controls(iindex), Microsoft.Office.Core.CommandBarButton)
    Next iindex

    If objbutton.FaceId = giCHECKBOX_FACEID Then
        objbutton.FaceId = 1
        objbutton.State = Microsoft.Office.Core.MsoButtonState.msoButtonUp
        Exit Sub
    End If
    If objbutton.FaceId = 1 Then
        objbutton.FaceId = giCHECKBOX_FACEID
        objbutton.State = Microsoft.Office.Core.MsoButtonState.msoButtonDown
        Exit Sub
    End If

    If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
    Call Error_Handle("CmdBar_DropDownCheckboxToggle", msMODULENAME, 1, _
         "toggle the value of the checkbox with parameter """ & sCheckBoxParameter & """" & _
         " on the drop-down menu with tag """ & sDropDownTag & """" & vbCrLf & _
         "on the command bar called """ & sBarName & """")
End Sub

CmdBar_DropDownControlEnabled

Enables or disables a control on a drop-down menu on a command bar.

Public Sub CmdBar_DropDownControlEnabled(ByVal bEnable As Boolean, _
                                         ByVal sBarName As String, _
                                         ByVal sDropDownName As String, _
                                         ByVal sControlItemName As String, _
                                Optional ByVal iDropDownCtrlNo As Integer = 0, _
                                Optional ByVal iCheckBoxCtrlNo As Integer = 0)
   On Error GoTo AnError
   CommandBars.Item(sBarName).Controls.Item(sDropDownName) _
                             .Controls(sControlItemName).Enabled = bEnable
   If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
   If sDropDownName = "" Then _
      serrortext = CommandBars.Item(sBarName).Controls(iDropDownCtrlNo).Name & _
                   " (ie control " & iDropDownCtrlNo & ")"
   If iDropDownCtrlNo = 0 Then serrortext = "dropdown """ & sDropDownName & """"
   
   Call Error_Handle("CmdBar_DropDownControlEnabled", msMODULENAME, 1, _
        bEnable & " the control """ & sControlItemName & """" & _
        " on the drop-down menu """ & sDropDownName & """" & _
        " on the command bar called """ & sBarName & """")
End Sub

CmdBar_DropDownControlExists

Determines if a particular control exists on a drop-down menu on a command bar. Returns True or False.

Public Function CmdBar_DropDownControlExists(ByVal sBarName As String, _
                                             ByVal sDropDownCaption As String, _
                                             ByVal sParameterName As String, _
                                    Optional ByVal iDropDownCtrl As Integer = 0) _
                                             As Boolean
                                    
Dim icontrolno As Integer
Dim objdropdownbar As CommandBarPopup
    
   On Error GoTo AnError
   
   CmdBar_DropDownControlExists = False
   
    For icontrolno = 1 To CommandBars.Item(sBarName).Controls.Count
       If CommandBars.Item(sBarName).Controls(icontrolno).Caption = sDropDownCaption Then
          Set objdropdownbar = CommandBars.Item(sBarName).Controls(icontrolno)
          Exit For
       End If
    Next icontrolno
   
   For icontrolno = 1 To objdropdownbar.Controls.Count
      If objdropdownbar.Controls(icontrolno).Parameter = sParameterName Then
         CmdBar_DropDownControlExists = True
         Exit For
      End If
   Next icontrolno
      
   If gbDEBUG_ERRMSG = False Then Exit Function
AnError:
   Call Error_Handle("CmdBar_DropDownControlExists", msMODULENAME, _
        "determine if the control with:" & vbCrLf & _
        "parameter " & sParameterName & vbCrLf & _
        "exists on the drop-down menu with:" & vbCrLf & _
        "caption " & sDropDownCaption & vbCrLf & _
        "on the command bar called '" & sBarName & "'.")
End Function

CmdBar_DropDownControlReset

Public Sub CmdBar_DropDownControlReset(ByVal sBarName As String, _
                                       ByVal sDropDownName As String, _
                              Optional ByVal iDropDownCtrl As Integer = 0)

   Dim objdropdownbar As Office.CommandBarPopup
   Dim icontrolno As Integer

   For icontrolno = 1 To CommandBars.Item(sBarName).Controls.Count
      Set objdropdownbar = CommandBars.Item(sBarName).Controls(icontrolno)
      If objdropdownbar.Caption = sDropDownName Then
         Set objdropdownbar = objdropdownbar
      End If
   Next icontrolno
   
   objdropdownbar.Reset

   If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
    Call Error_Handle("DropDownReset", msMODULENAME, 1, _
         "reset the drop-down with caption " & _
         "'" & sDropDownName & "'" & _
         vbCrLf & "on the command bar called '" & sBarName & "'.")
End Sub

CmdBar_DropDownControlsDelete

Delete all the controls on a drop-down menu on a command bar.

Public Sub CmdBar_DropDownControlsDelete(ByVal sBarName As String, _
                                         ByVal sDropDownName As String, _
                                Optional ByVal iDropDownCtrl As Integer = -1)
   On Error GoTo AnError


   If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
   If sDropDownName = "" Then _
      serrortext = CommandBars.Item(sBarName).Controls(iDropDownCtrlNo).Name & _
                   " (ie control " & iDropDownCtrlNo & ")"
   If iDropDownCtrlNo = 0 Then serrortext = "dropdown """ & sDropDownName & """"
   
   Call Error_Handle("CmdBar_DropDownControlsDelete", msMODULENAME, 1, _
        "delete all the controls " & _
        " on the drop-down menu """ & sDropDownName & """" & _
        " on the commandbar called """ & sBarName & """")
End Sub

CmdBar_DropDownExtendAdd

Adds an extension bar to a drop-down menu on a command bar.

Public Sub CmdBar_DropDownExtendAdd(ByVal sBarName As String, _
                                    ByVal sDropDownTag As String, _
                                    ByVal sExtensionCaption As String, _
                                    ByVal sParameterName As String, _
                                    ByVal sTagText As String, _
                           Optional ByVal bBeginGroup As Boolean = False, _
                           Optional ByVal sToolTipText As String = "", _
                           Optional ByVal bTemporary As Boolean = False)

    On Error GoTo AnError
    Dim objdropdownbar As Microsoft.Office.Core.CommandBarPopup
    Dim objextendbar As Microsoft.Office.Core.CommandBarPopup
    Dim objtemporary As Microsoft.Office.Core.MsoTriState

    If bTemporary = True Then objtemporary = Microsoft.Office.Core.MsoTriState.msoTrue
    If bTemporary = False Then objtemporary = Microsoft.Office.Core.MsoTriState.msoFalse

    objdropdownbar = CType(gApplication.CommandBars.Item(sBarName).FindControl(Tag:=sDropDownTag), _
                           Microsoft.Office.Core.CommandBarPopup)

    objextendbar = CType(objdropdownbar.Controls.Add( _
                         Type:=Microsoft.Office.Core.MsoControlType.msoControlPopup, _
                         Temporary:=objtemporary), Microsoft.Office.Core.CommandBarPopup)

    With objextendbar
        .Tag = sTagText
        .Caption = sExtensionCaption
        .TooltipText = sToolTipText
        .BeginGroup = bBeginGroup
    End With
    If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
    Call Error_Handle("CmdBar_DropDownExtendAdd", msMODULENAME, 1, _
         "add the extension bar """ & sExtensionCaption & """" & _
         " to the drop-down menu with tag """ & sDropDownTag & """" & vbCrLf & _
         "to the command bar called """ & sBarName & """")
End Sub

CmdBar_DropDownExtendButtonAdd

Adds a button to an extension bar on a drop-down menu on a command bar.

Public Sub CmdBar_DropDownExtendButtonAdd(ByVal sBarName As String, _
                                          ByVal sDropDownName As String, _
                                          ByVal sExtensionName As String, _
                                 Optional ByVal iDropDownCtrl As Integer = -1)
   On Error GoTo AnError


   If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
   If sDropDownName = "" Then _
      serrortext = CommandBars.Item(sBarName).Controls(iDropDownCtrlNo).Name & _
                   " (ie control " & iDropDownCtrlNo & ")"
   If iDropDownCtrlNo = 0 Then serrortext = "drop-down """ & sDropDownName & """"
   
   Call Error_Handle("CmdBar_DropDownExtendButtonAdd", msMODULENAME, 1, _
        "add a button to the extension bar """ & sExtensionName & """" & _
        " on the drop-down menu """ & sDropDownName & """" & _
        " on the command bar called """ & sBarName & """")
End Sub

CmdBar_DropDownExtendControlDelete

Removes a control from an extension bar on a drop-down menu on a command bar.

Public Sub CmdBar_DropDownExtendControlDelete(ByVal sBarName As String, _
                                              ByVal sDropDownName As String, _
                                              ByVal sExtensionName As String, _
                                              ByVal sControlName As String, _
                                     Optional ByVal iDropDownCtrl As Integer = -1, _
                                     Optional ByVal iControlNo As Integer = -1)
   On Error GoTo AnError


   If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
   If sDropDownName = "" Then _
      serrortext = CommandBars.Item(sBarName).Controls(iDropDownCtrlNo).Name & _
                   " (ie control " & iDropDownCtrlNo & ")"
   If iDropDownCtrlNo = 0 Then serrortext = "drop-down """ & sDropDownName & """"
   
   Call Error_Handle("CmdBar_DropDownExtendControlDelete", msMODULENAME, 1, _
        "remove the control """ & sControlName & """" & _
        " from the extension bar """ & sExtensionName & """" & _
        " on the drop-down menu """ & sDropDownName & """" & _
        " on the command bar called """ & sBarName & """")
End Sub

CmdBar_DropDownExtendControlEnabled

Enables or disables a control on an extension bar on a drop-down menu on a command bar.

Public Sub CmdBar_DropDownExtendControlEnabled(ByVal bEnable As Boolean, _
                                               ByVal sBarName As String, _
                                               ByVal sDropDownName As String, _
                                               ByVal sExtensionName As String, _
                                               ByVal sControlName As String, _
                                      Optional ByVal iDropDownCtrl As Integer = -1, _
                                      Optional ByVal iControlNo As Integer = -1)
Dim serrortext As String
   On Error GoTo AnError


   If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
   If sDropDownName = "" Then _
      serrortext = CommandBars.Item(sBarName).Controls(iDropDownCtrlNo).Name & _
                   " (ie control " & iDropDownCtrlNo & ")"
   If iDropDownCtrlNo = 0 Then serrortext = "drop-down """ & sDropDownName & """"
   
   Call Error_Handle("CmdBar_DropDownExtendControlEnabled", msMODULENAME, 1, _
        bEnable & " the control """ & sControlName & """" & _
        " from the extension bar """ & sExtensionName & """" & _
        " on the drop-down menu """ & sDropDownName & """" & _
        " on the command bar called """ & sBarName & """")
End Sub

CmdBar_DropDownExtendControlsDelete

Deletes all the controls on an extension bar on a drop-down menu on a command bar.

Public Sub CmdBar_DropDownExtendControlsDelete(ByVal sBarName As String, _
                                               ByVal sDropDownName As String, _
                                               ByVal sExtensionName As String, _
                                      Optional ByVal iDropDownCtrl As Integer = -1)
   On Error GoTo AnError


   If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
   If sDropDownName = "" Then _
      serrortext = CommandBars.Item(sBarName).Controls(iDropDownCtrlNo).Name & _
                   " (ie control " & iDropDownCtrlNo & ")"
   If iDropDownCtrlNo = 0 Then serrortext = "drop-down """ & sDropDownName & """"
   
   Call Error_Handle("CmdBar_DropDownExtendControlsDelete", msMODULENAME, 1, _
        "delete all the controls " & _
        " on the extension bar """ & sExtensionName & """" & _
        " on the drop-down menu """ & sDropDownName & """" & _
        " on the command bar called """ & sBarName & """")
End Sub

CmdBar_DropDownReset

Public Sub CmdBar_DropDownControlReset(ByVal sBarName As String, _
                                       ByVal sDropDownName As String, _
                              Optional ByVal iDropDownCtrl As Integer = 0)

   Dim objdropdownbar As Office.CommandBarPopup
   Dim icontrolno As Integer

   For icontrolno = 1 To CommandBars.Item(sBarName).Controls.Count
      Set objdropdownbar = CommandBars.Item(sBarName).Controls(icontrolno)
      If objdropdownbar.Caption = sDropDownName Then
         Set objdropdownbar = objdropdownbar
         Exit For
      End If
   Next icontrolno
   
   objdropdownbar.Reset

   If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
    Call Error_Handle("DropDownReset", msMODULENAME, 1, _
         "reset the drop-down with caption " & _
         "'" & sDropDownName & "'" & _
         vbCrLf & " on the command bar called '" & sBarName & "'.")
End Sub

CmdBar_Exists

Determines if a particular command bar already exists. Returns True or False.

Public Function CmdBar_Exists(ByVal sBarName As String, _
                     Optional ByVal bInformUser As Boolean = False) As Boolean

    On Error GoTo AnError
    Dim commandsBarName As Office.CommandBar

    CmdBar_Exists = False
    For Each commandsBarName In CommandBars
        If commandsBarName.name = sBarName Then
            CmdBar_Exists = True
            If bInformUser = True Then
                Call MsgBox("'" & sBarName & "' already exists !", VBA.VbMsgBoxStyle.vbInformation)
            End If
            Exit For
        End If
    Next
    If gbDEBUG_ERRMSG = False Then Exit Function
AnError:
    CmdBar_Exists = False
    Call Error_Handle("CmdBar_Exists", msMODULENAME, _
         "determine if a command bar called '" & sBarName & "' currently exists.")
End Function

CmdBar_FindDropDown

Public Function CmdBar_FindDropDownReturn(ByVal sBarName As String, _
                                 Optional ByVal iDropDownID As Integer, _
                                 Optional ByVal sDropDownCaption As String = "", _
                                 Optional ByVal sDropDownTag As String = "") As CommandBarPopup

Dim icontrolno As Integer

   On Error GoTo AnError

   If Len(sDropDownCaption) > 0 Then
      For icontrolno = 1 To CommandBars.Item(sBarName).Controls.Count
         If CommandBars.Item(sBarName).Controls(icontrolno).Caption = sDropDownCaption Then
            Set CmdBar_FindDropDownReturn = CommandBars.Item(sBarName).Controls(icontrolno)
            Exit Function
         End If
      Next icontrolno
   End If
   
   If Len(sDropDownTag) > 0 Then
      For icontrolno = 1 To CommandBars.Item(sBarName).Controls.Count
         If CommandBars.Item(sBarName).Controls(icontrolno).Tag = sDropDownTag Then
            Set CmdBar_FindDropDownReturn = CommandBars.Item(sBarName).Controls(icontrolno)
            Exit Function
         End If
      Next icontrolno
   End If
   
   If gbDEBUG_ERRMSG = False Then Exit Function
AnError:
   Call Error_Handle("CmdBar_FindDropDownReturn", msMODULENAME, _
        "")
End Function

CmdBar_FindDropDownControlNumber

Public Function CmdBar_FindDropDownControlNumber(ByVal objDropDownPopUp As CommandBarPopup, _
                                                 ByVal sControlID As String, _
                                                 ByVal sControlCaption As String, _
                                                 ByVal sControlTag As String, _
                                                 ByVal sControlParameter As String) _
                                                 As Integer

Dim icontrolno As Integer

   On Error GoTo AnError

   With objDropDownPopUp
   
      If sControlID > 0 Then
         For icontrolno = 1 To objDropDownPopUp.Controls.Count
            If .Controls(icontrolno).ID = sControlID Then Exit For
         Next icontrolno
      End If
      
      If Len(sControlCaption) > 0 Then
         For icontrolno = 1 To objDropDownPopUp.Controls.Count
            If .Controls(icontrolno).Caption = sControlCaption Then Exit For
         Next icontrolno
      End If

      If Len(sControlParameter) > 0 Then
         For icontrolno = 1 To objDropDownPopUp.Controls.Count
            If .Controls(icontrolno).Parameter = sControlParameter Then Exit For
         Next icontrolno
      End If
         
      If Len(sControlTag) > 0 Then
         For icontrolno = 1 To objDropDownPopUp.Controls.Count
            If .Controls(icontrolno).Tag = sControlTag Then Exit For
         Next icontrolno
      End If
   End With
   
   CmdBar_FindDropDownControlNumber = icontrolno
      
   If gbDEBUG_ERRMSG = False Then Exit Function
AnError:
   Call Error_Handle("CmdBar_FindDropDownControlNumber", msMODULENAME, _
        "")
End Function

CmdBar_FindPopUp

Public Function CmdBar_FindDropDownReturn(ByVal sBarName As String, _
                                 Optional ByVal iDropDownID As Integer, _
                                 Optional ByVal sDropDownCaption As String = "", _
                                 Optional ByVal sDropDownTag As String = "") As CommandBarPopup

Dim icontrolno As Integer

   On Error GoTo AnError

   If Len(sDropDownCaption) > 0 Then
      For icontrolno = 1 To CommandBars.Item(sBarName).Controls.Count
         If CommandBars.Item(sBarName).Controls(icontrolno).Caption = sDropDownCaption Then
            Set CmdBar_FindDropDownReturn = CommandBars.Item(sBarName).Controls(icontrolno)
            Exit Function
         End If
      Next icontrolno
   End If
   
   If Len(sDropDownTag) > 0 Then
      For icontrolno = 1 To CommandBars.Item(sBarName).Controls.Count
         If CommandBars.Item(sBarName).Controls(icontrolno).Tag = sDropDownTag Then
            Set CmdBar_FindDropDownReturn = CommandBars.Item(sBarName).Controls(icontrolno)
            Exit Function
         End If
      Next icontrolno
   End If
   
   If gbDEBUG_ERRMSG = False Then Exit Function
AnError:
   Call Error_Handle("CmdBar_FindDropDownReturn", msMODULENAME, _
        "")
End Function

CmdBar_Get

Returns the command bar object for a given command bar. If the command bar does not exist then Nothing is returned.

Public Function CmdBar_Get(ByVal sBarName As String) As Office.CommandBar

    On Error GoTo AnError
    Dim commandsBarName As Office.CommandBar

    commandsBarName = Nothing
    For Each commandsBarName In CommandBars
        If commandsBarName.name = sBarName Then
            CmdBar_Get = commandsBarName
            Exit For
        End If
    Next

    If gbDEBUG_ERRMSG = False Then Exit Function
AnError:
    CmdBar_Get = Nothing
    Call Error_Handle("CmdBar_Get", msMODULENAME, _
         "return the command bar called '" & sBarName & "'.")
End Function

CmdBar_Reset

Public Sub CmdBar_Reset(ByVal sBarName As String)
    On Error GoTo AnError

    gApplication.CommandBars(sBarName).Reset()

    If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
    Call Error_Handle("CmdBar_Reset", msMODULENAME, 3, _
         "reset the command bar """ & sBarName & """")
End Sub

CmdBar_Show

Displays a command bar. Shows and Hides ??.

Public Sub CmdBar_Show(ByVal sBarName As String, _
                       ByVal bShowIt As Boolean)
    On Error GoTo AnError
    If (bShowIt = True And gApplication.CommandBars.Item(sBarName).Visible = False) Then
        gApplication.CommandBars.Item(sBarName).Visible = True
    ElseIf (bShowIt = False And gApplication.CommandBars.Item(sBarName).Visible = True) Then
        gApplication.CommandBars.Item(sBarName).Visible = False
    Else
    End If
    If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
    Call Error_Handle("CmdBar_Show", msMODULENAME, 1, _
         "show the command bar called """ & sBarName & """")
End Sub

CmdBar_TextBoxAdd

Adds a text box to a command bar.

Public Sub CmdBar_TextBoxAdd(ByVal sBarName As String, _
                             ByVal iTextBoxWidth As Integer, _
                             ByVal bStartgroup As Boolean)
Dim barcontrol As CommandBarControl
   On Error GoTo AnError
   Set barcontrol = CommandBars.Item(sBarName).Controls.Add(Type:=msoControlEdit)
   With barcontrol
      .Width = iTextBoxWidth
      .BeginGroup = bStartgroup
   End With
   If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
   Call Error_Handle("CmdBar_TextBoxAdd", msMODULENAME, 1, _
        "add a textbox to the command bar called """ & sBarName & """")
End Sub

CmdBar_Visible

Public Function CmdBar_Visible(ByVal sBarName As String) As Boolean
    On Error GoTo AnError

    CmdBar_Visible = gApplication.CommandBars.Item(sBarName).Visible

    If gbDEBUG_ERRMSG = False Then Exit Function
AnError:
    Call Error_Handle("CmdBar_Visible", msMODULENAME, 1, _
         "determine if the command bar called """ & sBarName & """ is visible")
End Function

Create_ChartRibbon

Public Function Ribbon_Create_ChartRibbon() As String
   Dim sxml As String
   Dim formContent As String
   Dim template As String
   
   On Error GoTo AnError
   
   sxml = sxml & Tag_CustomUI("2007")
   sxml = sxml & Tag_Ribbon(2, False)
   sxml = sxml & Tag_Tabs(4)
   sxml = sxml & Tag_Tab(6, "Tab_Name, "", "FORMAT", "")
      
   sxml = sxml & Tag_Group(8, "Group_Charts", "Chart")
   sxml = sxml & Tag_Button(10, "Create Chart", "", _
                                "ChartTypeAllInsertDialog", "", "large", _
                                "Create a chart")
                                        
   sxml = sxml & Tag_Button(10, "Format Chart", "", _
                                "ChartLayoutGallery", "", "large", _
                                "Format the active chart")

   sxml = sxml & Tag_Button(10, "Colour Palette", "", _
                                "AppointmentColorDialog", "", "large", _
                                "Update the colours of the active chart")
                                        
   sxml = sxml & Tag_Separator(10, "Sep1")
   
   sxml = sxml & Tag_Button(10, "Show/Hide Legend", "ToggleLegend", _
                                "ChartLegend", "", "normal")
   sxml = sxml & Tag_Button(10, "Show/Hide Gridlines", "ToggleGridlines", _
                                "ChartDepthGridlines", "", "normal")
   sxml = sxml & Tag_Button(10, "Show/Hide Data Labels", "ToggleDataLabels", _
                                "ChartDataLabel", "", "normal")
                                        
'   sxml = sxml & Tag_CheckBox(10, "Include Legend", "")
'   sxml = sxml & Tag_CheckBox(10, "Include Gridlines", "")
'   sxml = sxml & Tag_CheckBox(10, "Include Data Labels", "")
                                        
   sxml = sxml & Tag_End(8, "group")
   
   sxml = sxml & Tag_Group(8, "Group_Tables", "Table")

   sxml = sxml & Tag_Button(10, "Format Table", "", _
                                "TablePropertiesDialog", "", "large", _
                                "Format the active chart")


   sxml = sxml & Tag_Menu(10, "Quick Format", True, "", "TableStylesGalleryExcel", "", True, "large", "Quick Format")

   sxml = sxml & Tag_Button(12, "Heading", "", _
                                "TablePropertiesDialog", "", "")
   sxml = sxml & Tag_Button(12, "Data Rows", "", _
                                "TablePropertiesDialog", "", "")
   sxml = sxml & Tag_Button(12, "Highlight 1", "", _
                                "TablePropertiesDialog", "", "")
   sxml = sxml & Tag_Button(12, "Highlight 2", "", _
                                "TablePropertiesDialog", "", "")
                                
   sxml = sxml & Tag_End(8, "menu")


   sxml = sxml & Tag_Separator(10, "Sep2")

'   sxml = sxml & Space(10) & Tag_ToggleButton("ShowRuler", _
'                                              "DisplayRuler", "", "large", _
'                                              "Display Ruler", _
'                                              "Toggle the display of the ruler")
                                                                                            
   sxml = sxml & Tag_CheckBox(10, "Show/Hide Table Ruler", "ShowHideTableRuler", _
                                 "Toggle the display of the ruler")

   'sxml = sxml & Space(10) & Tag_LabelControl("SelectRulerSize", "Ruler size:")

   sxml = sxml & Tag_DropDown(10, "RulerSizes", "xxxxxxxxxxxxxxxxxxxxxxxxx")
   sxml = sxml & Tag_ItemAdd(12, "Placeholder Ruler Size")
   sxml = sxml & Tag_ItemAdd(12, "Cover Size")
   sxml = sxml & Tag_ItemAdd(12, "Side by Side Portrait")
   sxml = sxml & Tag_ItemAdd(12, "Indented Portrait")
   sxml = sxml & Tag_ItemAdd(12, "Full Width Portrait")
   sxml = sxml & Tag_ItemAdd(12, "Side by Side Landscape")
   sxml = sxml & Tag_ItemAdd(12, "Full Width Landscape")
   sxml = sxml & Tag_ItemAdd(12, "Three Across Landscape")
   sxml = sxml & Tag_End(10, "dropDown")

   sxml = sxml & Tag_End(8, "group")

   sxml = sxml & Tag_Group(8, "Group_CopyTo", "Copy")

   sxml = sxml & Tag_Button(10, "Picture", "CopyPicture", _
                                "OmsPreviewPane", "", "large", _
                                "Create a chart")

   sxml = sxml & Tag_Button(10, "Linked", "CopyLinkedPicture", _
                                "FileLinksToFiles", "", "large", _
                                "Format the active chart")

   sxml = sxml & Tag_Button(10, "Clipboard", "CopyToClipboard", _
                                "Copy", "", "large", _
                                "copy to clipboard")

   sxml = sxml & Tag_Separator(10, "Sep3")

   sxml = sxml & Tag_Button(10, "Folder", "SaveToFolder", _
                                "FileOpen", "", "large", _
                                "Save picture to a folder location")

   sxml = sxml & Tag_End(8, "group")

   sxml = sxml & Tag_Group(8, "Group_User", "User")

   sxml = sxml & Tag_Button(10, "Options", "", _
                                "HappyFace", "", "large", _
                                "Get some help")
   
   sxml = sxml & Tag_Button(10, "Assistance", "", _
                                "TentativeAcceptInvitation", "", "large", _
                                 "Get some help")

   sxml = sxml & Tag_End(8, "group")
   sxml = sxml & Tag_End(6, "tab")
   sxml = sxml & Tag_End(4, "tabs")
   sxml = sxml & Tag_End(2, "ribbon")
   sxml = sxml & Tag_End(0, "customUI")
                        
   'sxml = Replace(sxml, " ", "")
            
   Ribbon_Create = sxml
   Exit Function
  
AnError:
   Call MsgBox(msMODULENAME, "Ribbon_Create_ChartRibbon", Err)
End Function

DynamicMenu_ExcelWindow

Public Function DynamicMenu_ExcelWindow(ByVal control As IRibbonControl) As String
Dim sxml As String

   sxml = sxml & Tag_DynamicMenuStart("2007")
      
   sxml = sxml & Tag_Button(14, "WindowNew")
   sxml = sxml & Tag_Button(14, "WindowsArrangeAll", "Arrange...")
   sxml = sxml & Tag_ToggleButton(14, "ViewSideBySide", "Compare Side by Side with...")
   sxml = sxml & Tag_Button(14, "WindowHide")
   sxml = sxml & Tag_Button(14, "WindowUnhide")
   sxml = sxml & Sep___Menu(14, "Window", 1)
   sxml = sxml & Tag_ToggleButton(14, "WindowSplitToggle")
   
   'sxml = sxml & Tag_Gallery2(14, "ViewFreezePanesGallery")
   
   sxml = sxml & Tag_Menu(14, "", "Freeze", "WindowMenuFreeze")
   sxml = sxml & Tag_Button(16, "", "Freeze Apply Remove")
   sxml = sxml & Tag_Button(16, "", "Freeze Top Row")
   sxml = sxml & Tag_Button(16, "", "Freeze First Column ")
   sxml = sxml & Tag_End(14, "menu")
      
   sxml = sxml & Sep___Menu(14, "Window", 2)
   
   sxml = sxml & Tag_Menu(14, "", "WindowSwitchWindowsMenuExcel")
   sxml = sxml & Tag_ToggleButton(16, "", "MISSING - What What", "MISSINGWhatWhat")
   sxml = sxml & Tag_End(14, "menu")
   
   sxml = sxml & Tag_End(12, "menu")

   DynamicMenu_ExcelWindow = sxml
End Function

Sep___Menu

Public Function Sep___Menu(ByVal iIndent As Integer, _
                           ByVal sMenuName As String, _
                           ByVal iSeperatorNo As Integer, _
                  Optional ByVal sTitle As String, _
                  Optional ByVal sGetTitle As String, _
                  Optional ByVal bVisible As Boolean = True, _
                  Optional ByVal sGetVisible As String = "") As String
                                  
Dim colArguments As New Collection
Dim sreturn As String

   On Error GoTo AnError
   
   'populate the collection with the arguments
   If Len(sTitle) > 0 Then colArguments.Add "sTitle", "sTitle"
   If Len(sGetTitle) > 0 Then colArguments.Add "sGetTitle", "sGetTitle"
   If (bVisible = False) Then colArguments.Add "bVisible", "bVisible"
   If Len(sGetVisible) > 0 Then colArguments.Add "sGetVisible", "sGetVisible"
   
   
   sreturn = sreturn & Space(iIndent) & "   sreturn = sreturn & " id=""" & sMenuName & "MenuSeperator" & iSeperatorNo & """"
   
   If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   
   If Len(sTitle) > 0 Then
      colArguments.Remove "sTitle"
      sreturn = sreturn & Space(iIndent + 14) & " Title=""" & sTitle & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sGetTitle) > 0 Then
      colArguments.Remove "sGetTitle"
      sreturn = sreturn & Space(iIndent + 14) & " getTitle=""" & sGetTitle & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If (bVisible = False) Then
      colArguments.Remove "bVisible"
      sreturn = sreturn & Space(iIndent + 14) & " visible=""false"""
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sGetVisible) > 0 Then
      colArguments.Remove "sGetVisible"
      sreturn = sreturn & Space(iIndent + 14) & " getVisible=""" & sGetVisible & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   sreturn = sreturn & "/>"
   
   Sep___Menu = sreturn & vbCrLf
   Exit Function
    
AnError:
   Call Error_Handle2(msMODULENAME, "Sep___Menu", Err)
End Function

Sep__Bar

Public Function Sep__Bar(ByVal iIndent As Integer, _
                         ByVal sToolbarName As String, _
                         ByVal iSeperatorNo As Integer, _
                Optional ByVal bVisible As Boolean = True) As String
                     
Dim sreturn As String

   On Error GoTo AnError
   
   sreturn = sreturn & Space(iIndent) & "   sreturn = sreturn & " id=""" & sToolbarName & "ToolbarSeperator" & iSeperatorNo & """"

   If (bVisible = False) Then
      sreturn = sreturn & Space(iIndent + 10) & " visible=""false""" & vbCrLf
   End If

   sreturn = sreturn & Space(iIndent) & "/>"
   
   Sep__Bar = sreturn & vbCrLf
   Exit Function
    
AnError:
   Call Error_Handle2(msMODULENAME, "Sep__Bar", Err)
End Function

Tag_Box

Public Function Tag_Box(ByVal iIndent As Integer, _
                        ByVal sID As String, _
               Optional ByVal bVertical As Boolean = False) As String
                        
Dim colArguments As New Collection
Dim sreturn As String

   On Error GoTo AnError
   
   'populate the collection with the arguments
   If (bVertical = True) Then colArguments.Add "bVertical", "bVertical"
   
   sreturn = sreturn & Space(iIndent) & "   sreturn = sreturn & " id=""" & sID & """"
   If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   
   If bVertical = False Then
      sreturn = sreturn & vbCrLf & Space(iIndent + 4) & " boxStyle=""horizontal"""
   Else
      colArguments.Remove "bVertical"
      sreturn = sreturn & Space(iIndent + 4) & " boxStyle=""vertical"""
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If

   sreturn = sreturn & ">"
   
   Tag_Box = sreturn & vbCrLf
   Exit Function
    
AnError:
   Call Error_Handle2(msMODULENAME, "Tag_Box", Err)
End Function

Tag_Button

Public Function Tag_Button(ByVal iIndent As Integer, _
                           ByVal sIDMso As String, _
                  Optional ByVal sLabel As String, _
                  Optional ByVal sID As String, _
                  Optional ByVal sImageMso As String, _
                  Optional ByVal sImage As String, _
                  Optional ByVal sSize As String, _
                  Optional ByVal sGetEnabled As String = "", _
                  Optional ByVal sScreentip As String = "", _
                  Optional ByVal bShowLabel As Boolean = True, _
                  Optional ByVal bShowImage As Boolean = True, _
                  Optional ByVal sSupertip As String = "", _
                  Optional ByVal sMenuItemDescription As String = "", _
                  Optional ByVal sTag As String = "", _
                  Optional ByVal bVisible As Boolean = True) As String
                           
Dim colArguments As New Collection
Dim sreturn As String

   On Error GoTo AnError
   
   'populate the collection with the arguments
   If Len(sIDMso) > 0 Then colArguments.Add "sIDMso", "sIDMso"
   If Len(sLabel) > 0 Then colArguments.Add "sLabel", "sLabel"
   If Len(sID) > 0 Then colArguments.Add "sID", "sID"
   If Len(sImageMso) > 0 Then colArguments.Add "sImageMso", "sImageMso"
   If Len(sImage) > 0 Then colArguments.Add "sImage", "sImage"
   If Len(sSize) > 0 Then colArguments.Add "sSize", "sSize"
   If Len(sGetEnabled) > 0 Then colArguments.Add "sGetEnabled", "sGetEnabled"
   If Len(sScreentip) > 0 Then colArguments.Add "sScreentip", "sScreentip"
   If (bShowLabel = False) Then colArguments.Add "bShowLabel", "bShowLabel"
   If (bShowImage = False) Then colArguments.Add "bShowImage", "bShowImage"
   If Len(sSupertip) > 0 Then colArguments.Add "sSupertip", "sSupertip"
   If Len(sMenuItemDescription) > 0 Then colArguments.Add "sMenuItemDescription", "sMenuItemDescription"
   If Len(sTag) > 0 Then colArguments.Add "sTag", "sTag"
   If (bVisible = False) > 0 Then colArguments.Add "bVisible", "bVisible"
   
   sreturn = sreturn & Space(iIndent) & "   
   If (Len(sIDMso) > 0) Then
      colArguments.Remove "sIDMso"
      sreturn = sreturn & " idMso=""" & sIDMso & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   Else
      If (Len(sID) = 0) Then
         sreturn = sreturn & " id=""" & Replace(sLabel, " ", "") & """" & vbCrLf
         sreturn = sreturn & Space(iIndent + 7) & " onAction=""Button_" & Replace(sLabel, " ", "") & """"
         If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
      End If
   
      If (Len(sID) > 0) Then
         colArguments.Remove "sID"
         sreturn = sreturn & " id=""" & sID & """" & vbCrLf
         sreturn = sreturn & Space(iIndent + 7) & " onAction=""Button_" & sID & """"
         If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
      End If
   End If
   
   If Len(sImageMso) > 0 Then
      colArguments.Remove "sImageMso"
      sreturn = sreturn & Space(iIndent + 7) & " imageMso=""" & sImageMso & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sImage) > 0 Then
      colArguments.Remove "sImage"
      sreturn = sreturn & Space(iIndent + 7) & " image=""" & sImage & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sSize) > 0 Then
      colArguments.Remove "sSize"
      sreturn = sreturn & Space(iIndent + 7) & " size=""" & sSize & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sGetEnabled) > 0 Then
      colArguments.Remove "sGetEnabled"
      sreturn = sreturn & Space(iIndent + 7) & " getEnabled=""" & sGetEnabled & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sLabel) > 0 Then
      colArguments.Remove "sLabel"
      sreturn = sreturn & Space(iIndent + 7) & " label=""" & sLabel & """"
      
      If (Len(sLabel) > 7) Then
         If (Left(sLabel, 7) = "MISSING") Then
            sreturn = sreturn & vbCrLf & Space(iIndent + 7) & " enabled=""false"""
         End If
      End If
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sScreentip) > 0 Then
      colArguments.Remove "sScreentip"
      sreturn = sreturn & Space(iIndent + 7) & " screentip=""" & sScreentip & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If (bShowLabel = False) Then
      colArguments.Remove "bShowlabel"
      sreturn = sreturn & Space(iIndent + 7) & " showLabel=""false"""
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If (bShowImage = False) Then
      colArguments.Remove "bShowImage"
      sreturn = sreturn & Space(iIndent + 7) & " showImage=""false"""
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sSupertip) > 0 Then
      colArguments.Remove "sSupertip"
      sreturn = sreturn & Space(iIndent + 7) & " supertip=""" & sSupertip & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sMenuItemDescription) > 0 Then
      colArguments.Remove "sMenuItemDescription"
      sreturn = sreturn & Space(iIndent + 7) & " description=""" & sMenuItemDescription & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sTag) > 0 Then
      colArguments.Remove "sTag"
      sreturn = sreturn & Space(iIndent + 7) & " tag=""" & sTag & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If (bVisible = False) Then
      colArguments.Remove "bVisible"
      sreturn = sreturn & Space(iIndent + 7) & " visible=""false"""
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
      
   sreturn = sreturn & "/>"
   
   Tag_Button = sreturn & vbCrLf
   Exit Function
    
AnError:
   Call Error_Handle2(msMODULENAME, "Tag_Button", Err)
End Function

Tag_ButtonGroup

Public Function Tag_ButtonGroup(ByVal iIndent As Integer, _
                                ByVal sID As String, _
                       Optional ByVal sTag As String = "", _
                       Optional ByVal bVisible As Boolean = True) As String
                       
Dim colArguments As New Collection
Dim sreturn As String

   On Error GoTo AnError
   
   'populate the collection with the arguments
   If Len(sID) > 0 Then colArguments.Add "sID", "sID"
   If Len(sTag) > 0 Then colArguments.Add "sTag", "sTag"
   If bVisible = False Then colArguments.Add "bVisible", "bVisible"
      
   sreturn = sreturn & Space(iIndent) & "   
   If Len(sID) > 0 Then
      colArguments.Remove "sID"
      sreturn = sreturn & " id=""" & sID & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
  
   If Len(sTag) > 0 Then
      colArguments.Remove "sTag"
      sreturn = sreturn & Space(iIndent + 12) & " tag=""" & sTag & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If (bVisible = False) Then
      colArguments.Remove "bVisible"
      sreturn = sreturn & Space(iIndent + 12) & " visible=""false"""
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   sreturn = sreturn & ">"
 
   Tag_ButtonGroup = sreturn & vbCrLf
   Exit Function
    
AnError:
   Call Error_Handle2(msMODULENAME, "Tag_ButtonGroup", Err)
End Function

Tag_CheckBox

Public Function Tag_CheckBox(ByVal iIndent As Integer, _
                             ByVal sIDMso As String, _
                    Optional ByVal sLabel As String = "", _
                    Optional ByVal sID As String, _
                    Optional ByVal sScreentip As String = "", _
                    Optional ByVal sSupertip As String = "", _
                    Optional ByVal sTag As String = "", _
                    Optional ByVal bVisible As Boolean = True) As String

Dim colArguments As New Collection
Dim sreturn As String

    On Error GoTo AnError
    
    'populate the collection with the arguments
    If Len(sIDMso) > 0 Then colArguments.Add "sIDMso", "sIDMso"
    If Len(sLabel) > 0 Then colArguments.Add "sLabel", "sLabel"
    If Len(sID) > 0 Then colArguments.Add "sID", "sID"
    If Len(sScreentip) > 0 Then colArguments.Add "sScreentip", "sScreentip"
    If Len(sSupertip) > 0 Then colArguments.Add "sSupertip", "sSupertip"
    If Len(sTag) > 0 Then colArguments.Add "sTag", "sTag"
    If bVisible = False Then colArguments.Add "bVisible", "bVisible"
   
    sreturn = sreturn & Space(iIndent) & "    
    If (Len(sIDMso) > 0) Then
        colArguments.Remove "sIDMso"
        sreturn = sreturn & " idMso=""" & sIDMso & """"
        If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
    Else
        If Len(sID) = 0 Then
            sreturn = sreturn & " id=""" & Replace(sLabel, " ", "") & """" & vbCrLf
            sreturn = sreturn & Space(iIndent + 9) & " onAction=""CheckBox_" & Replace(sLabel, " ", "") & """"
            If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
        End If
        
        If Len(sID) > 0 Then
            colArguments.Remove "sID"
            sreturn = sreturn & " id=""" & sID & """" & vbCrLf
            sreturn = sreturn & Space(iIndent + 9) & " onAction=""CheckBox_" & sID & """"
            If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
        End If
    End If
    
    If Len(sLabel) > 0 Then
        colArguments.Remove "sLabel"
        sreturn = sreturn & Space(iIndent + 9) & " label=""" & sLabel & """"
        If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
    End If

    If Len(sScreentip) > 0 Then
        colArguments.Remove "sScreentip"
        sreturn = sreturn & Space(iIndent + 9) & " screentip=""" & sScreentip & """"
        If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
    End If
   
    If Len(sSupertip) > 0 Then
        colArguments.Remove "sSupertip"
        sreturn = sreturn & Space(iIndent + 9) & " supertip=""" & sSupertip & """"
        If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
    End If
    
    If Len(sTag) > 0 Then
        colArguments.Remove "sTag"
        sreturn = sreturn & Space(iIndent + 9) & " tag=""" & sTag & """"
        If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
    End If
    
    If (bVisible = False) Then
        colArguments.Remove "bVisible"
        sreturn = sreturn & Space(iIndent + 9) & " visible=""false"""
        If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
    End If
   
    sreturn = sreturn & "/>"
 
    Tag_CheckBox = sreturn & vbCrLf
    Exit Function
    
AnError:
    Call Error_Handle2(msMODULENAME, "Tag_CheckBox", Err)
End Function

Tag_ComboBox

Public Function Tag_ComboBox(ByVal iIndent As Integer, _
                             ByVal sID As String, _
                    Optional ByVal sSizeString As String = "", _
                    Optional ByVal sScreentip As String = "", _
                    Optional ByVal sSupertip As String = "", _
                    Optional ByVal sTag As String = "", _
                    Optional ByVal bVisible As Boolean = True) As String

Dim colArguments As New Collection
Dim sreturn As String

   On Error GoTo AnError
   
   'populate the collection with the arguments
   If Len(sID) > 0 Then colArguments.Add "sID", "sID"
   If Len(sSizeString) > 0 Then colArguments.Add "sSizeString", "sSizeString"
   If Len(sScreentip) > 0 Then colArguments.Add "sScreentip", "sScreentip"
   If Len(sSupertip) > 0 Then colArguments.Add "sSupertip", "sSupertip"
   If Len(sTag) > 0 Then colArguments.Add "sTag", "sTag"
   If bVisible = False Then colArguments.Add "bVisible", "bVisible"
   
   sreturn = sreturn & Space(iIndent) & "   
   If Len(sID) > 0 Then
      colArguments.Remove "sID"
      sreturn = sreturn & " id=""" & sID & """" & vbCrLf
      
      sreturn = sreturn & Space(iIndent + 9) & " onAction=""ComboBox_" & sID & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   
   
   If Len(sSizeString) > 0 Then
      colArguments.Remove "sSizeString"
      sreturn = sreturn & Space(iIndent + 9) & " sizeString=""" & sSizeString & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sScreentip) > 0 Then
      colArguments.Remove "sScreentip"
      sreturn = sreturn & Space(iIndent + 9) & " screentip=""" & sScreentip & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sSupertip) > 0 Then
      colArguments.Remove "sSupertip"
      sreturn = sreturn & Space(iIndent + 9) & " supertip=""" & sSupertip & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sTag) > 0 Then
      colArguments.Remove "sTag"
      sreturn = sreturn & Space(iIndent + 9) & " tag=""" & sTag & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If (bVisible = False) Then
      colArguments.Remove "bVisible"
      sreturn = sreturn & Space(iIndent + 9) & " visible=""false"""
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   sreturn = sreturn & ">"
   
   Tag_ComboBox = sreturn & vbCrLf
   Exit Function
    
AnError:
   Call Error_Handle2(msMODULENAME, "Tag_ComboBox", Err)
End Function

Tag_Control

Public Function Tag_Control(ByVal iIndent As Integer, _
                            ByVal sIDMso As String, _
                   Optional ByVal sLabel As String = "", _
                   Optional ByVal bShowLabel As Boolean = True) As String
                   
Dim colArguments As New Collection
Dim sreturn As String

   On Error GoTo AnError

   'populate the collection with the arguments
   If Len(sIDMso) > 0 Then colArguments.Add "sIDMso", "sIDMso"
   If Len(sLabel) > 0 Then colArguments.Add "sLabel", "sLabel"
   If bShowLabel = False Then colArguments.Add "bShowLabel", "bShowLabel"
   
   sreturn = sreturn & Space(iIndent) & "
   If Len(sIDMso) > 0 Then
      colArguments.Remove "sIDMso"
      sreturn = sreturn & " idMso=""" & sIDMso & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If

   If Len(sLabel) > 0 Then
      colArguments.Remove "sLabel"
      sreturn = sreturn & Space(iIndent + 8) & " label=""" & sLabel & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If bShowLabel = False Then
      colArguments.Remove "bShowLabel"
      sreturn = sreturn & Space(iIndent + 8) & " showLabel=""false"""
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If

'      sreturn = sreturn & Space(iIndent + 9) & " onAction=""DropDown_" & sID & """"

   sreturn = sreturn & "/>"
   
   Tag_Control = sreturn & vbCrLf
   Exit Function
    
AnError:
   Call Error_Handle2(msMODULENAME, "Tag_Control", Err)
End Function

Tag_CustomUI

Public Function Tag_CustomUI(ByVal sVersion As String, _
                             ByVal bInStudio As Boolean, _
                             ByVal bUseLoadImageCallback As Boolean) As String
Dim sreturn As String
Dim sschema As String

   On Error GoTo AnError
   
   sreturn = ""
   
   If (bInStudio = True) Then
      sreturn = sreturn & "" & vbCrLf
   End If
   
   If sVersion = "2007" Then sschema = "http://schemas.microsoft.com/office/2006/01/customui"
   If sVersion = "2010" Then sschema = "http://schemas.microsoft.com/office/2009/07/customui"

   sreturn = sreturn & "      
   If (bInStudio = True) Then
      sreturn = sreturn & vbCrLf & " onLoad=""Ribbon_Load"""
   End If
   
   If (bUseLoadImageCallback = True) Then
      sreturn = sreturn & vbCrLf & " loadImage=""Callback_LoadImage"""
   End If
   
   sreturn = sreturn & ">"
   sreturn = sreturn & vbCrLf
   
   Tag_CustomUI = sreturn
   Exit Function
    
AnError:
   Call Error_Handle2(msMODULENAME, "Tag_CustomUI", Err)
End Function

Tag_DropDown

Public Function Tag_DropDown(ByVal iIndent As Integer, _
                             ByVal sID As String, _
                             ByVal sSizeString As String, _
                    Optional ByVal sScreentip As String = "", _
                    Optional ByVal sSupertip As String = "", _
                    Optional ByVal sTag As String = "", _
                    Optional ByVal bVisible As Boolean = True) As String

Dim colArguments As New Collection
Dim sreturn As String

   On Error GoTo AnError
   
   'populate the collection with the arguments
   If Len(sID) > 0 Then colArguments.Add "sID", "sID"
   If Len(sSizeString) > 0 Then colArguments.Add "sSizeString", "sSizeString"
   If Len(sScreentip) > 0 Then colArguments.Add "sScreentip", "sScreentip"
   If Len(sSupertip) > 0 Then colArguments.Add "sSupertip", "sSupertip"
   If Len(sTag) > 0 Then colArguments.Add "sTag", "sTag"
   If bVisible = False Then colArguments.Add "bVisible", "bVisible"
   
   sreturn = sreturn & Space(iIndent) & "   
    If Len(sID) > 0 Then
        colArguments.Remove "sID"
        sreturn = sreturn & " id=""" & sID & """" & vbCrLf
      
        sreturn = sreturn & Space(iIndent + 9) & " onAction=""DropDown_" & sID & """"
        If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
    End If
    
    If Len(sSizeString) > 0 Then
        colArguments.Remove "sSizeString"
        sreturn = sreturn & Space(iIndent + 9) & " sizeString=""" & sSizeString & """"
        If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
    End If
    
    If Len(sScreentip) > 0 Then
        colArguments.Remove "sScreentip"
        sreturn = sreturn & Space(iIndent + 9) & " screentip=""" & sScreentip & """"
        If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
    End If
    
    If Len(sSupertip) > 0 Then
        colArguments.Remove "sSupertip"
        sreturn = sreturn & Space(iIndent + 9) & " supertip=""" & sSupertip & """"
        If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
    End If
    
    If Len(sTag) > 0 Then
        colArguments.Remove "sTag"
        sreturn = sreturn & Space(iIndent + 9) & " tag=""" & sTag & """"
        If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
    End If
    
    If (bVisible = False) Then
        colArguments.Remove "bVisible"
        sreturn = sreturn & Space(iIndent + 9) & " visible=""false"""
        If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
    End If
    
    sreturn = sreturn & ">"
   
    Tag_DropDown = sreturn & vbCrLf
    Exit Function
    
AnError:
   Call Error_Handle2(msMODULENAME, "Tag_DropDown", Err)
End Function

Tag_DynamicMenu

Public Function Tag_DynamicMenu(ByVal iIndent As Integer, _
                                ByVal sIDMso As String, _
                                ByVal sLabel As String, _
                                ByVal sID As String, _
                                ByVal sImageMso As String, _
                                ByVal sImage As String, _
                                ByVal sgetcontent As String, _
                       Optional ByVal bShowLabel As Boolean = True, _
                       Optional ByVal bShowImage As Boolean = False, _
                       Optional ByVal sSize As String = "", _
                       Optional ByVal sDescription As String = "", _
                       Optional ByVal sScreentip As String = "", _
                       Optional ByVal sSupertip As String = "", _
                       Optional ByVal sTag As String = "", _
                       Optional ByVal bVisible As Boolean = True) As String
                       
Dim colArguments As New Collection
Dim sreturn As String

   On Error GoTo AnError
   
   'populate the collection with the arguments
   If Len(sIDMso) > 0 Then colArguments.Add "sIDMso", "sIDMso"
   If Len(sLabel) > 0 Then colArguments.Add "sLabel", "sLabel"
   If Len(sID) > 0 Then colArguments.Add "sID", "sID"
   If Len(sImageMso) > 0 Then colArguments.Add "sImageMso", "sImageMso"
   If Len(sImage) > 0 Then colArguments.Add "sImage", "sImage"
   If Len(sgetcontent) > 0 Then colArguments.Add "sGetContent", "sGetContent"
   If (bShowLabel = False) Then colArguments.Add "bShowLabel", "bShowLabel"
   If (bShowImage = False) Then colArguments.Add "bShowImage", "bShowImage"
   If Len(sSize) > 0 Then colArguments.Add "sSize", "sSize"
   If Len(sDescription) > 0 Then colArguments.Add "sDescription", "sDescription"
   If Len(sScreentip) > 0 Then colArguments.Add "sScreentip", "sScreentip"
   If Len(sSupertip) > 0 Then colArguments.Add "sSupertip", "sSupertip"
   If Len(sTag) > 0 Then colArguments.Add "sTag", "sTag"
   If (bVisible = False) Then colArguments.Add "bVisible", "bVisible"
   
   sreturn = sreturn & Space(iIndent) & "   
   If Len(sIDMso) > 0 Then
      colArguments.Remove "sIDMso"
      sreturn = sreturn & " idMso=""" & sIDMso & """"
   Else
      If (Len(sID) = 0) Then sreturn = sreturn & " id=""" & Replace(sLabel, " ", "") & """"
      If (Len(sID) > 0) Then
         colArguments.Remove "sID"
         sreturn = sreturn & " id=""" & sID & """"
      End If
   End If
   If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
    
   If Len(sLabel) > 0 Then
      colArguments.Remove "sLabel"
      sreturn = sreturn & Space(iIndent + 5) & " label=""" & sLabel & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If (bShowLabel = False) Then
      colArguments.Remove "bShowLabel"
      sreturn = sreturn & Space(iIndent + 5) & " showLabel=""false"""
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
      
   If Len(sImageMso) > 0 Then
      colArguments.Remove "sImageMso"
      sreturn = sreturn & Space(iIndent + 5) & " imageMso=""" & sImageMso & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sImage) > 0 Then
      colArguments.Remove "sImage"
      sreturn = sreturn & Space(iIndent + 5) & " image=""" & sImage & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sgetcontent) > 0 Then
      colArguments.Remove "sGetContent"
      sreturn = sreturn & Space(iIndent + 5) & " getContent=""" & sgetcontent & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If (bShowImage = False) Then
      colArguments.Remove "bShowImage"
      sreturn = sreturn & Space(iIndent + 5) & " showImage=""false"""
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
  
   If Len(sSize) > 0 Then
      colArguments.Remove "sSize"
      sreturn = sreturn & Space(iIndent + 5) & " size=""" & sSize & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sDescription) > 0 Then
      colArguments.Remove "sDescription"
      sreturn = sreturn & Space(iIndent + 5) & " description=""" & sDescription & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If

   If Len(sScreentip) > 0 Then
      colArguments.Remove "sScreentip"
      sreturn = sreturn & Space(iIndent + 5) & " screentip=""" & sScreentip & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sSupertip) > 0 Then
      colArguments.Remove "sSupertip"
      sreturn = sreturn & Space(iIndent + 5) & " supertip=""" & sSupertip & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sTag) > 0 Then
      colArguments.Remove "sTag"
      sreturn = sreturn & Space(iIndent + 5) & " tag=""" & sTag & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If (bVisible = False) Then
      colArguments.Remove "bVisible"
      sreturn = sreturn & Space(iIndent + 5) & " visible=""false"""
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
      
   If Len(sIDMso) > 0 Then
      sreturn = sreturn & "/>"
   Else
      sreturn = sreturn & ">"
   End If
   
   sreturn = sreturn & Space(iIndent) & ">"
   
   Tag_DynamicMenu = sreturn & vbCrLf
   Exit Function
    
AnError:
   Call Error_Handle2(msMODULENAME, "Tag_DynamicMenu", Err)
End Function

Tag_EditBox

Public Function Tag_EditBox(ByVal iIndent As Integer, _
                            ByVal sID As String, _
                            ByVal sGetText As String, _
                   Optional ByVal sTag As String = "", _
                   Optional ByVal bVisible As Boolean = True) As String

Dim sreturn As String

   On Error GoTo AnError
   
   sreturn = sreturn & Space(iIndent) & "   sreturn = sreturn & " id=""" & sID & """" & vbCrLf
   sreturn = sreturn & Space(iIndent + 8) & " onChange=""EditBox_" & sID & """" & vbCrLf
   
   If Len(sGetText) > 0 Then
      sreturn = sreturn & Space(iIndent + 8) & " getText=""" & sGetText & """" & vbCrLf
   End If
   
   If Len(sTag) > 0 Then
      sreturn = sreturn & Space(iIndent + 8) & " tag=""" & sTag & """" & vbCrLf
   End If
   
   If (bVisible = False) Then
      sreturn = Space(iIndent + 8) & sreturn & " visible=""false""" & vbCrLf
   End If
   
   sreturn = sreturn & Space(iIndent) & ">"
   
   Tag_EditBox = sreturn & vbCrLf
   Exit Function
    
AnError:
   Call Error_Handle2(msMODULENAME, "Tag_EditBox", Err)
End Function

Tag_End

Public Function Tag_End(ByVal iIndent As Integer, _
                        ByVal sTag As String) As String
Dim sreturn As String

   On Error GoTo AnError

   If sTag = "customUI" Then
      sreturn = Space(iIndent) & ""
   Else
      sreturn = Space(iIndent) & "" & vbCrLf
   End If
   
   Tag_End = sreturn
   Exit Function
    
AnError:
   Call Error_Handle2(msMODULENAME, "Tag_End", Err)
End Function

Tag_Gallery

Public Function Tag_Gallery2(ByVal iIndent As Integer, _
                            ByVal sIDMso As String, _
                   Optional ByVal sID As String, _
                   Optional ByVal sLabel As String = "", _
                   Optional ByVal sSize As String, _
                   Optional ByVal bShowLabel As Boolean = True, _
                   Optional ByVal iItemHeight As Integer = -1, _
                   Optional ByVal iItemWidth As Integer = -1, _
                   Optional ByVal iRows As Integer = -1, _
                   Optional ByVal iColumns As Integer = -1) As String

Dim colArguments As New Collection
Dim sreturn As String

   On Error GoTo AnError
   
   'populate the collection with the arguments
   If Len(sIDMso) > 0 Then colArguments.Add "sIDMso", "sIDMso"
   If Len(sID) > 0 Then colArguments.Add "sID", "sID"
   If Len(sSize) > 0 Then colArguments.Add "sSize", "sSize"
   If Len(sLabel) > 0 Then colArguments.Add "sLabel", "sLabel"
   If bShowLabel = False Then colArguments.Add "bShowLabel", "bShowLabel"
   If iItemHeight > -1 Then colArguments.Add "iItemHeight", "iItemHeight"
   If iItemWidth > -1 Then colArguments.Add "iItemWidth", "iItemWidth"
   If iRows > -1 Then colArguments.Add "iRows", "iRows"
   If iColumns > -1 Then colArguments.Add "iColumns", "iColumns"
   
   sreturn = sreturn & Space(iIndent) & "   
   If Len(sIDMso) > 0 Then
      colArguments.Remove "sIDMso"
      sreturn = sreturn & " idMso=""" & sIDMso & """"
   Else
      If Len(sID) > 0 Then
         colArguments.Remove "sID"
         sreturn = sreturn & " id=""" & sID & """"
      End If
   End If
   If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
      
   If Len(sSize) > 0 Then
      colArguments.Remove "sSize"
      sreturn = sreturn & Space(iIndent + 8) & " size=""" & sSize & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sLabel) > 0 Then
      colArguments.Remove "sLabel"
      sreturn = sreturn & Space(iIndent + 8) & " label=""" & sLabel & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If bShowLabel = False Then
      colArguments.Remove "bShowLabel"
      sreturn = sreturn & Space(iIndent + 8) & " showLabel=""false"""
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If (iItemHeight > -1) Then
      colArguments.Remove "iItemHeight"
      sreturn = sreturn & Space(iIndent + 8) & " itemHeight=""" & iItemHeight & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If (iItemWidth > -1) Then
      colArguments.Remove "iItemWidth"
      sreturn = sreturn & Space(iIndent + 8) & " itemWidth=""" & iItemWidth & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If (iRows > -1) Then
      colArguments.Remove "iRows"
      sreturn = sreturn & Space(iIndent + 8) & " rows=""" & iRows & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If (iColumns > -1) Then
      colArguments.Remove "iColumns"
      sreturn = sreturn & Space(iIndent + 8) & " itemHeight=""" & iColumns & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If

   sreturn = sreturn & "/>"

   Tag_Gallery2 = sreturn & vbCrLf
   Exit Function
    
AnError:
   Call Error_Handle2(msMODULENAME, "Tag_Gallery2", Err)
End Function

Tag_Group

Public Function Tag_Group(ByVal iIndent As Integer, _
                          ByVal sID As String, _
                          ByVal sLabel As String, _
                 Optional ByVal sGetVisible As String = "", _
                 Optional ByVal bVisible As Boolean = True) As String
                 
Dim colArguments As New Collection
Dim sreturn As String

   On Error GoTo AnError
   
   'populate the collection with the arguments
   If Len(sLabel) > 0 Then colArguments.Add "sLabel", "sLabel"
   If Len(sGetVisible) > 0 Then colArguments.Add "sGetVisible", "sGetVisible"
   If (bVisible = False) Then colArguments.Add "bVisible", "bVisible"
   
   sreturn = sreturn & Space(iIndent) & "   sreturn = sreturn & " id=""" & sID & """"
   If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   
   If Len(sLabel) > 0 Then
      colArguments.Remove "sLabel"
      sreturn = sreturn & Space(iIndent + 6) & " label=""" & sLabel & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sGetVisible) > 0 Then
      colArguments.Remove "sGetVisible"
      sreturn = sreturn & Space(iIndent + 4) & " getVisible=""" & sGetVisible & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If bVisible = False Then
      colArguments.Remove "bVisible"
      sreturn = sreturn & Space(iIndent + 6) & " visible=""false"""
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If

   sreturn = sreturn & ">"
   
   Tag_Group = sreturn & vbCrLf
   Exit Function
    
AnError:
   Call Error_Handle2(msMODULENAME, "Tag_Group", Err)
End Function

Tag_ItemAdd

Public Function Tag_ItemAdd(ByVal iIndent As Integer, _
                            ByVal sLabel As String, _
                   Optional ByVal sID As String = "") As String
                             
Dim colArguments As New Collection
Dim sreturn As String
          
    On Error GoTo AnError
   
    'populate the collection with the arguments
    If Len(sLabel) > 0 Then colArguments.Add "sLabel", "sLabel"
    If Len(sID) > 0 Then colArguments.Add "sID", "sID"

    sreturn = sreturn & Space(iIndent) & "   
    If Len(sID) = 0 Then
        sreturn = sreturn & " id=""" & Replace(sLabel, " ", "_") & """"
        If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
    Else
        colArguments.Remove "sID"
        sreturn = sreturn & " id=""" & sID & """" & vbCrLf
        If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
    End If

    If Len(sLabel) > 0 Then
        colArguments.Remove "sLabel"
        sreturn = sreturn & Space(iIndent + 5) & " label=""" & sLabel & """"
        If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
    End If
   
    sreturn = sreturn & "/>"
   
    Tag_ItemAdd = sreturn & vbCrLf
    Exit Function
    
AnError:
    Call Error_Handle2(msMODULENAME, "Tag_ItemAdd", Err)
End Function

Tag_LabelControl

Public Function Tag_LabelControl(ByVal iIndent As Integer, _
                                 ByVal sID As String, _
                                 ByVal sLabel As String, _
                        Optional ByVal bShowLabel = True, _
                        Optional ByVal sTag As String = "", _
                        Optional ByVal bVisible As Boolean = True) As String

Dim colArguments As New Collection
Dim sreturn As String

   On Error GoTo AnError
   
   'populate the collection with the arguments
   If Len(sID) > 0 Then colArguments.Add "sID", "sID"
   If Len(sLabel) > 0 Then colArguments.Add "sLabel", "sLabel"
   If bShowLabel = False Then colArguments.Add "bShowLabel", "bShowLabel"
   If Len(sTag) > 0 Then colArguments.Add "sTag", "sTag"
   If bVisible = False Then colArguments.Add "bVisible", "bVisible"
   
   sreturn = sreturn & Space(iIndent) & "   
   If Len(sID) > 0 Then
      colArguments.Remove "sID"
      sreturn = sreturn & " id=""" & sID & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sLabel) > 0 Then
      colArguments.Remove "sLabel"
      sreturn = sreturn & Space(iIndent + 13) & " label=""" & sLabel & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If bShowLabel = False Then
      colArguments.Remove "bShowLabel"
      sreturn = sreturn & Space(iIndent + 13) & " showLabel=""false"""
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If

   If Len(sTag) > 0 Then
      colArguments.Remove "sTag"
      sreturn = sreturn & Space(iIndent + 13) & " tag=""" & sTag & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If (bVisible = False) Then
      colArguments.Remove "bVisible"
      sreturn = sreturn & Space(iIndent + 13) & " visible=""false"""
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   sreturn = sreturn & "/>"
   
   Tag_LabelControl = sreturn & vbCrLf
   Exit Function
    
AnError:
   Call Error_Handle2(msMODULENAME, "Tag_LabelControl", Err)
End Function

Tag_Menu

Public Function Tag_Menu(ByVal iIndent As Integer, _
                         ByVal sIDMso As String, _
                Optional ByVal sLabel As String, _
                Optional ByVal sID As String, _
                Optional ByVal sImageMso As String, _
                Optional ByVal sImage As String, _
                Optional ByVal bShowLabel As Boolean = True, _
                Optional ByVal bShowImage As Boolean = True, _
                Optional ByVal sSize As String = "", _
                Optional ByVal sGetEnabled As String = "", _
                Optional ByVal sDescription As String = "", _
                Optional ByVal sScreentip As String = "", _
                Optional ByVal sSupertip As String = "", _
                Optional ByVal sTag As String = "", _
                Optional ByVal bVisible As Boolean = True) As String

Dim colArguments As New Collection
Dim sreturn As String

   On Error GoTo AnError
   
   'populate the collection with the arguments
   If Len(sIDMso) > 0 Then colArguments.Add "sIDMso", "sIDMso"
   If Len(sLabel) > 0 Then colArguments.Add "sLabel", "sLabel"
   If Len(sID) > 0 Then colArguments.Add "sID", "sID"
   If Len(sImageMso) > 0 Then colArguments.Add "sImageMso", "sImageMso"
   If Len(sImage) > 0 Then colArguments.Add "sImage", "sImage"
   If (bShowLabel = False) Then colArguments.Add "bShowLabel", "bShowLabel"
   If (bShowImage = False) Then colArguments.Add "bShowImage", "bShowImage"
   If Len(sSize) > 0 Then colArguments.Add "sSize", "sSize"
   If Len(sGetEnabled) > 0 Then colArguments.Add "sGetEnabled", "sGetEnabled"
   If Len(sDescription) > 0 Then colArguments.Add "sDescription", "sDescription"
   If Len(sScreentip) > 0 Then colArguments.Add "sScreentip", "sScreentip"
   If Len(sSupertip) > 0 Then colArguments.Add "sSupertip", "sSupertip"
   If Len(sTag) > 0 Then colArguments.Add "sTag", "sTag"
   If (bVisible = False) Then colArguments.Add "bVisible", "bVisible"
   
   sreturn = sreturn & Space(iIndent) & "   
   If Len(sIDMso) > 0 Then
      colArguments.Remove "sIDMso"
      sreturn = sreturn & " idMso=""" & sIDMso & """"
   Else
      If (Len(sID) = 0) Then sreturn = sreturn & " id=""" & Replace(sLabel, " ", "") & """"
      If (Len(sID) > 0) Then
         colArguments.Remove "sID"
         sreturn = sreturn & " id=""" & sID & """"
      End If
   End If
   If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
     
   If Len(sLabel) > 0 Then
      colArguments.Remove "sLabel"
      sreturn = sreturn & Space(iIndent + 5) & " label=""" & sLabel & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If (bShowLabel = False) Then
      colArguments.Remove "bShowLabel"
      sreturn = sreturn & Space(iIndent + 5) & " showLabel=""false"""
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
      
   If Len(sImageMso) > 0 Then
      colArguments.Remove "sImageMso"
      sreturn = sreturn & Space(iIndent + 5) & " imageMso=""" & sImageMso & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sImage) > 0 Then
      colArguments.Remove "sImage"
      sreturn = sreturn & Space(iIndent + 5) & " image=""" & sImage & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If (bShowImage = False) Then
      colArguments.Remove "bShowImage"
      sreturn = sreturn & Space(iIndent + 5) & " showImage=""false"""
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If

   If Len(sGetEnabled) > 0 Then
      colArguments.Remove "sGetEnabled"
      sreturn = sreturn & Space(iIndent + 5) & " getEnabled=""" & sGetEnabled & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sSize) > 0 Then
      colArguments.Remove "sSize"
      sreturn = sreturn & Space(iIndent + 5) & " size=""" & sSize & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sDescription) > 0 Then
      colArguments.Remove "sDescription"
      sreturn = sreturn & Space(iIndent + 5) & " description=""" & sDescription & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If

   If Len(sScreentip) > 0 Then
      colArguments.Remove "sScreentip"
      sreturn = sreturn & Space(iIndent + 5) & " screentip=""" & sScreentip & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sSupertip) > 0 Then
      colArguments.Remove "sSupertip"
      sreturn = sreturn & Space(iIndent + 5) & " supertip=""" & sSupertip & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sTag) > 0 Then
      colArguments.Remove "sTag"
      sreturn = sreturn & Space(iIndent + 5) & " tag=""" & sTag & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If (bVisible = False) Then
      colArguments.Remove "bVisible"
      sreturn = sreturn & Space(iIndent + 5) & " visible=""false"""
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If

   If Len(sIDMso) > 0 Then
      sreturn = sreturn & "/>"
   Else
      sreturn = sreturn & ">"
   End If

   Tag_Menu = sreturn & vbCrLf
   Exit Function
    
AnError:
   Call Error_Handle2(msMODULENAME, "Tag_Menu", Err)
End Function

Tag_OfficeMenu

Public Function Tag_OfficeMenu() As String

   On Error GoTo AnError
   
   Exit Function
    
AnError:
   Call Error_Handle(msMODULENAME, "Tag_OfficeMenu", Err)
End Function

Tag_QAT

Public Function Tag_QAT() As String

   On Error GoTo AnError
   
   Exit Function
    
AnError:
   Call Error_Handle(msMODULENAME, "Tag_QAT", Err)
End Function

Tag_Ribbon

Public Function Tag_Ribbon(ByVal iIndent As Integer, _
                           ByVal bStartFromScratch As Boolean) As String
Dim sreturn As String
Dim struefalse As String

   On Error GoTo AnError
   
   If bStartFromScratch = True Then struefalse = "true"
   If bStartFromScratch = False Then struefalse = "false"
   
   sreturn = Space(iIndent) & ""
   
   Tag_Ribbon = sreturn & vbCrLf
   Exit Function
    
AnError:
   Call Error_Handle2(msMODULENAME, "Tag_Ribbon", Err)
End Function

Tag_Separator

Public Function Tag_Separator(ByVal iIndent As Integer, _
                              ByVal sID As String, _
                     Optional ByVal bVisible As Boolean = True) As String
                     
Dim colArguments As New Collection
Dim sreturn As String

    On Error GoTo AnError

    'populate the collection with the arguments
    If Len(sID) > 0 Then colArguments.Add "sID", "sID"
    If bVisible = False Then colArguments.Add "bVisible", "bVisible"

    sreturn = sreturn & Space(iIndent) & "    
    If Len(sID) > 0 Then
        colArguments.Remove "sID"
        sreturn = sreturn & " id=""" & sID & """"
        If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
    End If

    If (bVisible = False) Then
        colArguments.Remove "bVisible"
        sreturn = sreturn & Space(iIndent + 10) & " visible=""false"""
        If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
    End If

    sreturn = sreturn & "/>"
   
    Tag_Separator = sreturn & vbCrLf
    Exit Function
    
AnError:
   Call Error_Handle2(msMODULENAME, "Tag_Separator", Err)
End Function

Tag_SplitButton

Public Function Tag_SplitButton(ByVal iIndent As Integer, _
                                ByVal sIDMso As String, _
                       Optional ByVal sID As String, _
                       Optional ByVal sSize As String, _
                       Optional ByVal bShowLabel As Boolean, _
                       Optional ByVal sScreentip As String = "", _
                       Optional ByVal sSupertip As String = "", _
                       Optional ByVal sTag As String = "", _
                       Optional ByVal bVisible As Boolean = True) As String
                       
Dim colArguments As New Collection
Dim sreturn As String

   On Error GoTo AnError
   
   'populate the collection with the arguments
   If Len(sIDMso) > 0 Then colArguments.Add "sIDMso", "sIDMso"
   If Len(sID) > 0 Then colArguments.Add "sID", "sID"
   If Len(sSize) > 0 Then colArguments.Add "sSize", "sSize"
   If bShowLabel = False Then colArguments.Add "bShowLabel", "bShowLabel"
   If Len(sScreentip) > 0 Then colArguments.Add "sScreentip", "sScreentip"
   If Len(sSupertip) > 0 Then colArguments.Add "sSupertip", "sSupertip"
   If Len(sTag) > 0 Then colArguments.Add "sTag", "sTag"
   If bVisible = False Then colArguments.Add "bVisible", "bVisible"
   
   sreturn = sreturn & Space(iIndent) & "   
   If Len(sIDMso) > 0 Then
      colArguments.Remove "sIDMso"
      sreturn = sreturn & " idMso=""" & sIDMso & """"
   Else
      If Len(sID) > 0 Then
         colArguments.Remove "sID"
         sreturn = sreturn & " id=""" & sID & """"
      End If
   End If
   If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   
   If Len(sSize) > 0 Then
      colArguments.Remove "sSize"
      sreturn = sreturn & Space(iIndent + 12) & " size=""" & sSize & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If bShowLabel = False Then
      colArguments.Remove "bShowLabel"
      sreturn = sreturn & Space(iIndent + 12) & " showLabel=""false"""
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sScreentip) > 0 Then
      colArguments.Remove "sScreentip"
      sreturn = sreturn & Space(iIndent + 12) & " screentip=""" & sScreentip & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sSupertip) > 0 Then
      colArguments.Remove "sSupertip"
      sreturn = sreturn & Space(iIndent + 12) & " supertip=""" & sSupertip & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sTag) > 0 Then
      colArguments.Remove "sTag"
      sreturn = sreturn & Space(iIndent + 12) & " tag=""" & sTag & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If (bVisible = False) Then
      colArguments.Remove "bVisible"
      sreturn = sreturn & Space(iIndent + 12) & " visible=""false"""
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   sreturn = sreturn & "/>"
   
   Tag_SplitButton = sreturn & vbCrLf
   Exit Function
    
AnError:
   Call Error_Handle2(msMODULENAME, "Tag_SplitButton", Err)
End Function

Tag_Tab

Public Function Tag_Tab(ByVal iIndent As Integer, _
                        ByVal sID As String, _
                        ByVal sIDMso As String, _
                        ByVal sLabel As String, _
                        ByVal sInsertAfterMso As String, _
               Optional ByVal sInsertBeforeMso As String = "", _
               Optional ByVal sTag As String = "", _
               Optional ByVal sGetVisible As String = "", _
               Optional ByVal bVisible As Boolean = True) As String
                        
Dim colArguments As New Collection
Dim sreturn As String

   On Error GoTo AnError
   
   'populate the collection with the arguments
   If Len(sIDMso) > 0 Then colArguments.Add "sIDMso", "sIDMso"
   If Len(sLabel) > 0 Then colArguments.Add "sLabel", "sLabel"
   If Len(sInsertAfterMso) > 0 Then colArguments.Add "sInsertAfterMso", "sInsertAfterMso"
   If Len(sInsertBeforeMso) > 0 Then colArguments.Add "sInsertBeforeMso", "sInsertBeforeMso"
   If Len(sTag) > 0 Then colArguments.Add "sTag", "sTag"
   If Len(sGetVisible) > 0 Then colArguments.Add "sGetVisible", "sGetVisible"
   If (bVisible = False) Then colArguments.Add "bVisible", "bVisible"
   
   sreturn = sreturn & Space(iIndent) & "   sreturn = sreturn & " id=""" & sID & """"
   If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   
   If Len(sIDMso) > 0 Then
      colArguments.Remove "sIDMso"
      sreturn = sreturn & Space(iIndent + 4) & " idMso=""" & sIDMso & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sLabel) > 0 Then
      colArguments.Remove "sLabel"
      sreturn = sreturn & Space(iIndent + 4) & " label=""" & sLabel & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sInsertAfterMso) > 0 Then
      colArguments.Remove "sInsertAfterMso"
      sreturn = sreturn & Space(iIndent + 4) & " insertAfterMso=""" & sInsertAfterMso & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sInsertBeforeMso) > 0 Then
      colArguments.Remove "sInsertBeforeMso"
      sreturn = sreturn & Space(iIndent + 4) & " insertBeforeMso=""" & sInsertBeforeMso & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If

   If Len(sTag) > 0 Then
      colArguments.Remove "sTag"
      sreturn = sreturn & Space(iIndent + 4) & " tag=""" & sTag & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sGetVisible) > 0 Then
      colArguments.Remove "sGetVisible"
      sreturn = sreturn & Space(iIndent + 4) & " getVisible=""" & sGetVisible & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If bVisible = False Then
      colArguments.Remove "bVisible"
      sreturn = sreturn & Space(iIndent + 4) & " visible=""false"""
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   sreturn = sreturn & ">"
   
   Tag_Tab = sreturn & vbCrLf
   Exit Function
    
AnError:
   Call Error_Handle2(msMODULENAME, "Tag_Tab", Err)
End Function

Tag_Tabs

Public Function Tag_Tabs(ByVal iIndent As Integer) As String
Dim sreturn As String

   On Error GoTo AnError
   
   sreturn = Space(iIndent) & ""
   
   Tag_Tabs = sreturn & vbCrLf
   Exit Function
    
AnError:
   Call Error_Handle2(msMODULENAME, "Tag_Tabs", Err)
End Function

Tag_ToggleButton

Public Function Tag_ToggleButton(ByVal iIndent As Integer, _
                                 ByVal sIDMso As String, _
                        Optional ByVal sLabel As String, _
                        Optional ByVal sID As String, _
                        Optional ByVal sImageMso As String, _
                        Optional ByVal sImage As String, _
                        Optional ByVal sSize As String, _
                        Optional ByVal sGetEnabled As String = "", _
                        Optional ByVal sScreentip As String = "", _
                        Optional ByVal bShowLabel As Boolean = True, _
                        Optional ByVal sSupertip As String = "", _
                        Optional ByVal sTag As String = "", _
                        Optional ByVal bVisible As Boolean = True) As String
                                 
Dim colArguments As New Collection
Dim sreturn As String

   On Error GoTo AnError
   
   'populate the collection with the arguments
   If Len(sIDMso) > 0 Then colArguments.Add "sIDMso", "sIDMso"
   If Len(sID) > 0 Then colArguments.Add "sID", "sID"
   If Len(sImageMso) > 0 Then colArguments.Add "sImageMso", "sImageMso"
   If Len(sImage) > 0 Then colArguments.Add "sImage", "sImage"
   If Len(sLabel) > 0 Then colArguments.Add "sLabel", "sLabel"
   If Len(sSize) > 0 Then colArguments.Add "sSize", "sSize"
   If Len(sGetEnabled) > 0 Then colArguments.Add "sGetEnabled", "sGetEnabled"
   If Len(sScreentip) > 0 Then colArguments.Add "sScreentip", "sScreentip"
   If bShowLabel = False Then colArguments.Add "bShowLabel", "bShowLabel"
   If Len(sSupertip) > 0 Then colArguments.Add "sSupertip", "sSupertip"
   If Len(sTag) > 0 Then colArguments.Add "sTag", "sTag"
   If bVisible = False Then colArguments.Add "bVisible", "bVisible"
   
   sreturn = sreturn & Space(iIndent) & "   
   If (Len(sIDMso) > 0) Then
      colArguments.Remove "sIDMso"
      sreturn = sreturn & " idMso=""" & sIDMso & """"
   Else
      If Len(sID) > 0 Then
         colArguments.Remove "sID"
         sreturn = sreturn & " id=""" & sID & """" & vbCrLf
         sreturn = sreturn & Space(iIndent + 13) & " onAction=""ToggleButton_" & sID & """"
      End If
   End If
   If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   
   If Len(sImageMso) > 0 Then
      colArguments.Remove "sImageMso"
      sreturn = sreturn & Space(iIndent + 13) & " imageMso=""" & sImageMso & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sImage) > 0 Then
      colArguments.Remove "sImage"
      sreturn = sreturn & Space(iIndent + 13) & " image=""" & sImage & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sLabel) > 0 Then
      colArguments.Remove "sLabel"
      sreturn = sreturn & Space(iIndent + 13) & " label=""" & sLabel & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
      
   If Len(sSize) > 0 Then
      colArguments.Remove "sSize"
      sreturn = sreturn & Space(iIndent + 13) & " size=""" & sSize & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sGetEnabled) > 0 Then
      colArguments.Remove "sGetEnabled"
      sreturn = sreturn & Space(iIndent + 13) & " getEnabled=""" & sGetEnabled & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sScreentip) > 0 Then
      colArguments.Remove "sScreentip"
      sreturn = sreturn & Space(iIndent + 13) & " screentip=""" & sScreentip & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If (bShowLabel = False) Then
      colArguments.Remove "bShowLabel"
      sreturn = sreturn & Space(iIndent + 13) & " showLabel=""false"""
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If

   If Len(sSupertip) > 0 Then
      colArguments.Remove "sSupertip"
      sreturn = sreturn & Space(iIndent + 13) & " supertip=""" & sSupertip & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If Len(sTag) > 0 Then
      colArguments.Remove "sTag"
      sreturn = sreturn & Space(iIndent + 13) & " tag=""" & sTag & """"
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   If (bVisible = False) Then
      colArguments.Remove "bVisible"
      sreturn = sreturn & Space(iIndent + 13) & " visible=""false"""
      If (colArguments.Count > 0) Then sreturn = sreturn & vbCrLf
   End If
   
   sreturn = sreturn & "/>"
   
   Tag_ToggleButton = sreturn & vbCrLf
   Exit Function
    
AnError:
   Call Error_Handle2(msMODULENAME, "Tag_ToggleButton", Err)
End Function

---

© 2024 Better Solutions Limited. All Rights Reserved. © 2024 Better Solutions Limited Top