Vba word application commandbars

title description keywords f1_keywords ms.prod api_name ms.assetid ms.date ms.localizationpriority

Application.CommandBars property (Word)

Learn how to return a CommandBars collection that represents the menu bar (Word)

vbawd10.chm158335033

vbawd10.chm158335033

word

Word.Application.CommandBars

1082697d-edc8-c619-40d1-466d2ebf3817

07/20/2021

medium

Application.CommandBars property (Word)

Returns a CommandBars collection that represents the menu bar and all the toolbars in Microsoft Word.

[!Important]
This property has changed. CommandBars(«Comments») cannot be used to customize the context menu for comments.

Syntax

expression.CommandBars

expression A variable that represents an Application object.

Remarks

Use the CustomizationContext property to set the template or document context prior to accessing the CommandBars collection.

For information about returning a single member of a collection, see Returning an object from a collection.

Example

This example enlarges all command bar buttons and enables ToolTips.

With CommandBars 
 .LargeButtons = True 
 .DisplayTooltips = True 
End With

This example displays the Drawing toolbar at the bottom of the application window.

With CommandBars("Drawing") 
 .Visible = True 
 .Position = msoBarBottom 
End With

This example adds the Versions command button to the Standard toolbar.

CustomizationContext = NormalTemplate 
CommandBars("Standard").Controls.Add Type:=msoControlButton, _ 
 ID:=2522, Before:=4

See also

Application Object

[!includeSupport and feedback]

Источник

Содержание

  • 1 Add a new commandbar
  • 2 Add ControlButton to CommandBar
  • 3 Adding a control to a command bar
  • 4 Add PopupControl to CommandBar
  • 5 Adjusting a control»s Visible property
  • 6 Attaching a drop-down list to a command bar
  • 7 Changing a control»s caption dynamically: Showing the user the current cell»s number format
  • 8 CommandBar Object
  • 9 CommandBars collection
  • 10 Counting custom toolbars
  • 11 Create Shortcut
  • 12 Creating a command bar: Set some properties when you create a new toolbar
  • 13 Creating a Toolbar: AddRemoveButton
  • 14 Creating a Toolbar and assign its action
  • 15 Creating a Toolbar and display MsgBox in its action
  • 16 Custom Toolbars
  • 17 deletes a control that has a caption of SortButton.
  • 18 Determines if a given command bar name exists
  • 19 Display Control Detail
  • 20 display shortcut menu with the ShowPopup method
  • 21 displays the Caption property for the first Control object contained in the Standard toolbar, whose index is 3.
  • 22 Finding Visible Controls with FindControls
  • 23 Get the type of CommandBars
  • 24 how your VBA code can change the position of a toolbar.
  • 25 Inspecting a CommandBar
  • 26 Listing all controls on all toolbars
  • 27 Listing the controls on a command bar
  • 28 Properties of CommandBar controls
  • 29 Rather than use an index number to refer to a control, you can use its Caption property setting
  • 30 Referring to command bars
  • 31 Removes a toolbar specified by the name passed in
  • 32 Removing all toolbars and then restoring them
  • 33 Replacing Excel»s built-in menu with your own
  • 34 Reset CommandBar
  • 35 Restores the Worksheet Menu Bar to its native state
  • 36 Restore tool bar
  • 37 Save list of all predefined commands and their ID numbers in a file
  • 38 Set Control style, Action, group, faceid and caption
  • 39 sets the FaceId property of the first button on the MyToolbar toolbar image to 45, which is the code number for a mailbox icon.
  • 40 Show All Toolbar Controls
  • 41 Show CommandBar Names
  • 42 show/hide check symbol
  • 43 Shows or hides a command bar.
  • 44 simply copies the NumberFormat property of the ActiveCell to the Caption property of the button control.
  • 45 The custom toolbar is removed with this procedure
  • 46 The Protection constants are additive: apply different types of protection with a single command
  • 47 The Protection property of a CommandBar object provides you with many options for protecting a CommandBar.
  • 48 This toolbar exists only when the cell pointer falls within a given range
  • 49 To delete a control from a CommandBar object, use the Delete method of the Controls collection
  • 50 Translates a MsoBarPosition enumeration into a text description of the bar position.
  • 51 Translates a MsoBarType enumeration into a text description of the bar type.
  • 52 Translates a MsoControlType enumeration into a text description of the control type.
  • 53 Working with Shortcut Menus

Add a new commandbar

   <source lang="vb">

Sub AddNewCB() 

  Dim myCommandBar As CommandBar, myCommandBarCtl As CommandBarControl
  On Error GoTo AddNewCB_Err
  Set myCommandBar = CommandBars.Add(Name:="Sample Toolbar", Position:= msoBarFloating)
  myCommandBar.Visible = True
  Set myCommandBarCtl = myCommandBar.Controls.Add(Type:=msoControlButton)
  With myCommandBarCtl
     .Caption = "Button"
     .Style = msoButtonCaption
     .TooltipText = "Display Message Box"
     .OnAction = "=MsgBox(""You pressed a toolbar button!"")"
  End With
  Set myCommandBarCtl = myCommandBar.Controls.Add(Type:=msoControlButton)
  With myCommandBarCtl
     .FaceId = 1000
     .Caption = "Toggle Button"
     .TooltipText = "Toggle First Button"
     .OnAction = "=ToggleButton()"
  End With
  Set myCommandBarCtl = myCommandBar.Controls.Add(msoControlComboBox)
  With myCommandBarCtl
     .Caption = "Drop Down"
     .Width = 100
     .AddItem "Create Button", 1
     .AddItem "Remove Button", 2
     .DropDownWidth = 100
     .OnAction = "=AddRemoveButton()"
  End With
  Exit Sub

AddNewCB_Err: 

  Debug.Print Err.number & vbCr & Err.Description
  Exit Sub

End Sub
Function ToggleButton() 

  Dim CBButton As CommandBarControl
  On Error GoTo ToggleButton_Err
  Set CBButton = CommandBars("Sample Toolbar").Controls(1)
  CBButton.Visible = Not CBButton.Visible
  Exit Function

ToggleButton_Err: 

  Debug.Print Err.number & vbCr & Err.Description
  Exit Function

End Function
Function AddRemoveButton() 

  Dim myCommandBar As CommandBar, CBCombo As CommandBarComboBox
  Dim CBNewButton As CommandBarButton
  
  On Error GoTo AddRemoveButton_Err
  
  Set myCommandBar = CommandBars("Sample Toolbar")
  Set CBCombo = myCommandBar.Controls(3)
  
  Select Case CBCombo.ListIndex
     Case 1
        Set CBNewButton = myCommandBar.Controls.Add(Type:=msoControlButton)
        With CBNewButton
           .Caption = "New Button"
           .Style = msoButtonCaption
           .BeginGroup = True
           .Tag = "New Button"
           .OnAction = "=MsgBox(""This is a new button!"")"
        End With
     Case 2
        Set CBNewButton = myCommandBar.FindControl(Tag:="New Button")
        CBNewButton.Delete
  End Select
  Exit Function

AddRemoveButton_Err: 

  If Err.number = 91 Then
     Debug.Print "Cannot remove button that does not exist!"
     Exit Function
  Else
     Debug.Print Err.number & vbCr & Err.Description
     Exit Function
  End If

End Function 

</source>

Add ControlButton to CommandBar

   <source lang="vb">

Sub AddNewMB() 

  Dim myCommandBar As CommandBar, myCommandBarCtl As CommandBarControl
  Dim myCommandBarSubCtl As CommandBarControl
  On Error GoTo AddNewMB_Err
  Set myCommandBar = CommandBars.Add(Name:="Sample Menu Bar", Position:= _
     msoBarTop, MenuBar:=True, Temporary:=False)
  myCommandBar.Visible = True
  myCommandBar.Protection = msoBarNoMove
  Set myCommandBarCtl = myCommandBar.Controls.Add(Type:=msoControlPopup)
  myCommandBarCtl.Caption = "Displa&y"
  Set myCommandBarSubCtl = myCommandBarCtl.Controls.Add(Type:=msoControlButton)
  With myCommandBarSubCtl
     .Style = msoButtonIconAndCaption
     .Caption = "E&nable ClickMe"
     .FaceId = 59
     .OnAction = "=MsgBox(""You clicked Enable ClickMe"")"
     .Parameter = 1
     .BeginGroup = True
  End With
  Set myCommandBarSubCtl = myCommandBarCtl.Controls.Add(Type:=msoControlButton)
  With myCommandBarSubCtl
     .Style = msoButtonIconAndCaption
     .Caption = "Di&sable ClickMe"
     .FaceId = 276
     .OnAction = "=MsgBox(""You Disable ClickMe"")"
     .Parameter = 2
     .BeginGroup = True
  End With
  Set myCommandBarCtl = myCommandBar.Controls.Add(Type:=msoControlButton)
  With myCommandBarCtl
     .BeginGroup = True
     .Caption = "&ClickMe"
     .Style = msoButtonCaption
     .OnAction = "=MsgBox(""You clicked ClickMe"")"
  End With
  Set myCommandBarCtl = myCommandBar.Controls.Add(Type:=msoControlButton)
  With myCommandBarCtl
     .BeginGroup = True
     .Caption = "&Set Visibility Off"
     .Style = msoButtonCaption
     .OnAction = "=MsgBox(""You set visibility off"")"
  End With
  Exit Sub

AddNewMB_Err: 

  msgBox "Error " & Err.number & vbCr & Err.Description
  Exit Sub

End Sub 

</source>

Adding a control to a command bar

   <source lang="vb">

Sub AddButton() 

   Set NewBtn = CommandBars("MyToolbar").Controls.Add _
     (Type:=msoControlButton)
   With NewBtn
      .FaceId = 300
      .OnAction = "MyMacro"
      .Caption = "Tooltip goes here"
   End With

End Sub 

</source>

Add PopupControl to CommandBar

   <source lang="vb">

Sub AddNewMB() 

  Dim myCommandBar As CommandBar, myCommandBarCtl As CommandBarControl
  Dim myCommandBarSubCtl As CommandBarControl
  On Error GoTo AddNewMB_Err
  Set myCommandBar = CommandBars.Add(Name:="Sample Menu Bar", Position:= _
     msoBarTop, MenuBar:=True, Temporary:=False)
  myCommandBar.Visible = True
  myCommandBar.Protection = msoBarNoMove
  Set myCommandBarCtl = myCommandBar.Controls.Add(Type:=msoControlPopup)
  myCommandBarCtl.Caption = "Displa&y"
  Set myCommandBarSubCtl = myCommandBarCtl.Controls.Add(Type:=msoControlButton)
  With myCommandBarSubCtl
     .Style = msoButtonIconAndCaption
     .Caption = "E&nable ClickMe"
     .FaceId = 59
     .OnAction = "=ToggleClickMe()"
     .Parameter = 1
     .BeginGroup = True
  End With

AddNewMB_Err: 

  msgBox "Error " & Err.number & vbCr & Err.Description
  Exit Sub

End Sub
Function ToggleClickMe() 

  Dim MyMenu As CommandBar
  Dim myCommandBarClickMe As CommandBarControl
  On Error GoTo ToggleClickMe_Err
  Set MyMenu = CommandBars("Sample Menu Bar")
  Set myCommandBarClickMe = MyMenu.Controls(2)
  With CommandBars.ActionControl
     Select Case .Parameter
        Case 1
           myCommandBarClickMe.Enabled = True
        Case 2
           myCommandBarClickMe.Enabled = False
     End Select
  End With
  Exit Function

ToggleClickMe_Err: 

  msgBox "Error " & Err.number & vbCr & Err.Description
  Exit Function

End Function 

</source>

Adjusting a control»s Visible property

   <source lang="vb">

Sub ToggleAllToolbars() 

   For Each cb In CommandBars
       If cb.Type = msoBarTypeNormal Then
           cb.Visible = Not cb.Visible
       End If
   Next cb

End Sub 

</source>

Attaching a drop-down list to a command bar

   <source lang="vb">

Sub Make() 

   Dim TBar As commandBar
   Dim NewDD As CommandBarControl
   Set TBar = CommandBars.Add
   Set NewDD = CommandBars("myBar").Controls.Add(Type:=msoControlDropdown)
   With NewDD
       .Caption = "Date"
       .OnAction = "yourAction"
       .Style = msoButtonAutomatic
       For i = 1 To 2
           .AddItem "Click"
       Next i
       .ListIndex = 1
   End With

End Sub
Sub yourAction() 

   With CommandBars("MonthList").Controls("DateDD")
       ActiveCell.value = .List(.ListIndex)
   End With

End Sub 

</source>

Changing a control»s caption dynamically: Showing the user the current cell»s number format

   <source lang="vb">

Sub MakeNumberFormatDisplay() 

   Dim TBar As CommandBar
   Dim NewBtn As CommandBarButton
   Set TBar = CommandBars.Add
   With TBar
       .Name = "Number Format"
       .Visible = True
   End With
   
   Set NewBtn = CommandBars("Number Format").Controls.Add(Type:=msoControlButton)
   With NewBtn
       .Caption = ""
       .OnAction = "ChangeNumFormat"
       .Style = msoButtonCaption
   End With

End Sub 

</source>

CommandBar Object

   <source lang="vb">

Sub CommandBarCount() 

  MsgBox "There are " & CommandBars.count & " command bars"

End Sub 

</source>

CommandBars collection

   <source lang="vb">

Sub com() 

   MsgBox CommandBars(1).Name

End Sub 

</source>

Counting custom toolbars

   <source lang="vb">

Sub CustomToolbars() 

   Dim cb As CommandBar
   For Each cb In CommandBars
       If cb.Type = msoBarTypeNormal Then
           If Not cb.BuiltIn Then
               Debug.Print "Not"
           End If
       End If
   Next cb

End Sub 

</source>

Create Shortcut

   <source lang="vb">

Sub CreateShortcut() 

   DeleteShortcut
   Set myBar = CommandBars.Add (Name:="MyShortcut", Position:=msoBarPopup, Temporary:=True)
   
   Set myItem = myBar.Controls.Add(Type:=msoControlButton)
   With myItem
       .Caption = "&Number Format..."
       .OnAction = "ShowFormatNumber"
       .FaceId = 1554
   End With
       
   Set myItem = myBar.Controls.Add(Type:=msoControlButton)
   With myItem
       .Caption = "&Alignment..."
       .OnAction = "ShowFormatAlignment"
       .FaceId = 217
   End With
       
   Set myItem = myBar.Controls.Add(Type:=msoControlButton)
   With myItem
       .Caption = "&Font..."
       .OnAction = "ShowFormatFont"
       .FaceId = 291
   End With

End Sub
Sub ShowFormatNumber() 

   Application.Dialogs(xlDialogFormatNumber).Show

End Sub
Sub ShowFormatAlignment() 

   Application.Dialogs(xlDialogAlignment).Show

End Sub
Sub ShowFormatFont() 

   Application.Dialogs(xlDialogFormatFont).Show

End Sub 

</source>

Creating a command bar: Set some properties when you create a new toolbar

   <source lang="vb">

Sub CreateAToolbar() 

   Dim TBar As CommandBar
   Set TBar = CommandBars.Add
   With TBar
       .name = "MyToolbar"
       .Top = 0
       .Left = 0
       .Visible = True
   End With

End Sub 

</source>

Creating a Toolbar: AddRemoveButton

   <source lang="vb">

Sub AddNewCB() 

  Dim myCommandBar As CommandBar, myCommandBarCtl As CommandBarControl
  On Error GoTo AddNewCB_Err
 Set myCommandBar = CommandBars.Add(Name:="Sample Toolbar", Position:= _
     msoBarFloating)
  myCommandBar.Visible = True
 Set myCommandBarCtl = myCommandBar.Controls.Add(msoControlComboBox)
  With myCommandBarCtl
     .Caption = "Drop Down"
     .Width = 100
     .AddItem "Create Button", 1
     .AddItem "Remove Button", 2
     .DropDownWidth = 100
     .OnAction = "=AddRemoveButton()"
  End With
  Exit Sub

AddNewCB_Err: 

  msgBox "Error " & Err.number & vbCr & Err.Description
  Exit Sub

End Sub
Function AddRemoveButton() 

  Dim myCommandBar As CommandBar, CBCombo As CommandBarComboBox
  Dim CBNewButton As CommandBarButton
  On Error GoTo AddRemoveButton_Err
  Set myCommandBar = CommandBars("Sample Toolbar")
  Set CBCombo = myCommandBar.Controls(3)
  Select Case CBCombo.ListIndex
     Case 1
        Set CBNewButton = myCommandBar.Controls.Add(Type:=msoControlButton)
        With CBNewButton
           .Caption = "New Button"
           .Style = msoButtonCaption
           .BeginGroup = True
           .Tag = "New Button"
           .OnAction = "=MsgBox(""This is a new button!"")"
        End With
     Case 2
        Set CBNewButton = myCommandBar.FindControl(Tag:="New Button")
        CBNewButton.Delete
  End Select
  Exit Function

AddRemoveButton_Err: 

  If Err.number = 91 Then
     msgBox "Cannot remove button that does not exist!"
     Exit Function
  Else
    msgBox "Error " & Err.number & vbCr & Err.Description
    Exit Function
  End If

End Function 

</source>

Creating a Toolbar and assign its action

   <source lang="vb">

Function ToggleButton() 

  Dim CBButton As CommandBarControl
  On Error GoTo ToggleButton_Err
  Set CBButton = CommandBars("Sample Toolbar").Controls(1)
  CBButton.Visible = Not CBButton.Visible
  Exit Function

ToggleButton_Err: 

  msgBox "Error " & Err.number & vbCr & Err.Description
  Exit Function

End Function
Sub AddNewCB() 

  Dim myCommandBar As CommandBar, myCommandBarCtl As CommandBarControl
  On Error GoTo AddNewCB_Err
 Set myCommandBar = CommandBars.Add(Name:="Sample Toolbar", Position:= _
     msoBarFloating)
  myCommandBar.Visible = True
  Set myCommandBarCtl = myCommandBar.Controls.Add(Type:=msoControlButton)
  With myCommandBarCtl
     .FaceId = 1000
     .Caption = "Toggle Button"
     .TooltipText = "Toggle First Button"
     .OnAction = "=ToggleButton()"
  End With
  Exit Sub

AddNewCB_Err: 

  msgBox "Error " & Err.number & vbCr & Err.Description
  Exit Sub

End Sub 

</source>

Creating a Toolbar and display MsgBox in its action

   <source lang="vb">

Sub AddNewCB() 

  Dim myCommandBar As CommandBar, myCommandBarCtl As CommandBarControl
  On Error GoTo AddNewCB_Err
 Set myCommandBar = CommandBars.Add(Name:="Sample Toolbar", Position:= _
     msoBarFloating)
  myCommandBar.Visible = True
 Set myCommandBarCtl = myCommandBar.Controls.Add(Type:=msoControlButton)
  With myCommandBarCtl
     .Caption = "Button"
     .Style = msoButtonCaption
     .TooltipText = "Display Message Box"
     .OnAction = "=MsgBox(""You pressed a toolbar button!"")"
  End With
  
  Exit Sub

AddNewCB_Err: 

  msgBox "Error " & Err.number & vbCr & Err.Description
  Exit Sub

End Sub 

</source>

Custom Toolbars

   <source lang="vb">

Private tlbMyToolbar As CommandBar
«Add tool bar
Sub AddToolbar() 

   Dim tlbMyButton As CommandBarButton
   Set tlbMyToolbar = Application.rumandBars.Add( _
       name:=" Example Toolbar", _
       Position:=msoBarFloating, _
       Temporary:=True)
   tlbMyToolbar.Visible = True
   Set tlbMyButton = tlbMyToolbar.Controls.Add( _
       Type:=msoControlButton, _
       Temporary:=True)
   tlbMyButton.Style = msoButtonIconAndCaption
   tlbMyButton.Picture = LoadPicture(ActiveWorkbook.Path & "myImage.bmp")
   tlbMyButton.Caption = "Test"

End Sub 

</source>

deletes a control that has a caption of SortButton.

   <source lang="vb">

Sub commandBar() 

   CommandBars("MyToolbar").Controls("SortButton").Delete

End Sub 

</source>

Determines if a given command bar name exists

   <source lang="vb">

Sub TestCommandBarUtilities() 

   Debug.Print CommandBarExists("Worksheet Menu Bar") 
   Debug.Print CommandBarExists("Formatting") 
   Debug.Print CommandBarExists("Not a command bar")

End Sub
Function CommandBarExists(sName As String) As Boolean 

   Dim s As String 
   On Error GoTo bWorksheetExistsErr 
   s = Application.rumandBars(sName).Name 
   CommandBarExists = True 
   Exit Function

bWorksheetExistsErr: 

   CommandBarExists = False

End Function 

</source>

Display Control Detail

   <source lang="vb">

Private Sub DisplayControlDetail() 

   Dim cb As CommandBar 
   Dim cbc As CommandBarControl 
   On Error Resume Next 
   For Each cb In Application.rumandBars 
       For Each cbc In cb.Controls 
           Debug.Print Replace(cbc.Caption, "&", "") 
           Debug.Print cbc.Caption 
           Debug.Print cbc.Index 
           Debug.Print cbc.BuiltIn 
           Debug.Print cbc.Enabled 
           Debug.Print cbc.Visible 
           Debug.Print cbc.IsPriorityDropped 
           Debug.Print cbc.Priority 
           Debug.Print TranslateControlType(cbc.Type) 
           Debug.Print cbc.Controls.Count 
       Next 
   Next
   Set cbc = Nothing

End Sub
Function TranslateControlType(vType As MsoControlType) As String 

   Dim sType As String 
   Select Case vType 
       Case Is = MsoControlType.msoControlActiveX 
           sType = "ActiveX" 
       Case Is = MsoControlType.msoControlAutoCompleteCombo 
           sType = "Auto Complete Combo" 
       Case Is = MsoControlType.msoControlButton 
           sType = "Button" 
       Case Is = MsoControlType.msoControlButtonDropdown 
           sType = "Button Dropdown" 
       Case Is = MsoControlType.msoControlButtonPopup 
           sType = "Button Popup" 
       Case Is = MsoControlType.msoControlComboBox 
           sType = "Combo Box" 
       Case Is = MsoControlType.msoControlCustom 
           sType = "Custom" 
       Case Is = MsoControlType.msoControlDropdown 
           sType = "Dropdown" 
       Case Is = MsoControlType.msoControlEdit 
           sType = "Edit" 
       Case Is = MsoControlType.msoControlExpandingGrid 
           sType = "Expanding Grid" 
       Case Is = MsoControlType.msoControlGauge 
           sType = "Gauge" 
       Case Is = MsoControlType.msoControlGenericDropdown 
           sType = "Generic Dropdown" 
       Case Is = MsoControlType.msoControlGraphicCombo 
           sType = "Graphic Combo" 
       Case Is = MsoControlType.msoControlGraphicDropdown 
           sType = "Graphic Dropdown" 
       Case Is = MsoControlType.msoControlGraphicPopup 
           sType = "Graphic Popup" 
       Case Is = MsoControlType.msoControlGrid 
           sType = "Grid" 
       Case Is = MsoControlType.msoControlLabel 
           sType = "Label" 
       Case Is = MsoControlType.msoControlLabelEx 
           sType = "Label Ex" 
       Case Is = MsoControlType.msoControlOCXDropdown 
           sType = "OCX Dropdown" 
       Case Is = MsoControlType.msoControlPane 
           sType = "Pane" 
       Case Is = MsoControlType.msoControlPopup 
           sType = "Popup" 
       Case Is = MsoControlType.msoControlSpinner 
           sType = "Spinner" 
       Case Is = MsoControlType.msoControlSplitButtonMRUPopup 
           sType = "Split Button MRU Popup" 
       Case Is = MsoControlType.msoControlSplitButtonPopup 
           sType = "Split Button Popup" 
       Case Is = MsoControlType.msoControlSplitDropdown 
           sType = "Split Dropdown" 
       Case Is = MsoControlType.msoControlSplitExpandingGrid 
           sType = "Split Expanding Grid" 
       Case Is = MsoControlType.msoControlWorkPane 
           sType = "Work Pane" 
       Case Else 
           sType = "Unknown control type" 
   End Select 
   TranslateControlType = sType

End Function 

</source>
   
  


   <source lang="vb">

Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean) 

   CommandBars("MyShortcut").ShowPopup
   Cancel = True

End Sub 

</source>

displays the Caption property for the first Control object contained in the Standard toolbar, whose index is 3.

   <source lang="vb">

Sub Test() 

   MsgBox CommandBars(3).Controls(1).Caption

End Sub 

</source>

Finding Visible Controls with FindControls

   <source lang="vb">

Sub FindVisibleControls() 

   Dim ctrls As CommandBarControls
   Dim ctrl As CommandBarControl
   Set ctrls = Application.rumandBars.FindControls(, , , True)
   For Each ctrl In ctrls
       Debug.Print ctrl.Parent.name
       Debug.Print ctrl.Caption
       Debug.Print ctrl.Index
       Debug.Print ctrl.ID
       Debug.Print ctrl.Enabled
       Debug.Print ctrl.Visible
       Debug.Print ctrl.IsPriorityDropped
       Debug.Print TranslateControlType(ctrl.Type)
   Next
   Set ctrl = Nothing
   Set ctrls = Nothing

End Sub
Function TranslateControlType(vType As MsoControlType) As String 

   Dim sType As String
   Select Case vType
       Case Is = MsoControlType.msoControlActiveX
           sType = "ActiveX"
       Case Is = MsoControlType.msoControlAutoCompleteCombo
           sType = "Auto Complete Combo"
       Case Is = MsoControlType.msoControlButton
           sType = "Button"
       Case Is = MsoControlType.msoControlButtonDropdown
           sType = "Button Dropdown"
       Case Is = MsoControlType.msoControlButtonPopup
           sType = "Button Popup"
       Case Is = MsoControlType.msoControlComboBox
           sType = "Combo Box"
       Case Is = MsoControlType.msoControlCustom
           sType = "Custom"
       Case Is = MsoControlType.msoControlDropdown
           sType = "Dropdown"
       Case Is = MsoControlType.msoControlEdit
           sType = "Edit"
       Case Is = MsoControlType.msoControlExpandingGrid
           sType = "Expanding Grid"
       Case Is = MsoControlType.msoControlGauge
           sType = "Gauge"
       Case Is = MsoControlType.msoControlGenericDropdown
           sType = "Generic Dropdown"
       Case Is = MsoControlType.msoControlGraphicCombo
           sType = "Graphic Combo"
       Case Is = MsoControlType.msoControlGraphicDropdown
           sType = "Graphic Dropdown"
       Case Is = MsoControlType.msoControlGraphicPopup
           sType = "Graphic Popup"
       Case Is = MsoControlType.msoControlGrid
           sType = "Grid"
       Case Is = MsoControlType.msoControlLabel
           sType = "Label"
       Case Is = MsoControlType.msoControlLabelEx
           sType = "Label Ex"
       Case Is = MsoControlType.msoControlOCXDropdown
           sType = "OCX Dropdown"
       Case Is = MsoControlType.msoControlPane
           sType = "Pane"
       Case Is = MsoControlType.msoControlPopup
           sType = "Popup"
       Case Is = MsoControlType.msoControlSpinner
           sType = "Spinner"
       Case Is = MsoControlType.msoControlSplitButtonMRUPopup
           sType = "Split Button MRU Popup"
       Case Is = MsoControlType.msoControlSplitButtonPopup
           sType = "Split Button Popup"
       Case Is = MsoControlType.msoControlSplitDropdown
           sType = "Split Dropdown"
       Case Is = MsoControlType.msoControlSplitExpandingGrid
           sType = "Split Expanding Grid"
       Case Is = MsoControlType.msoControlWorkPane
           sType = "Work Pane"
       Case Else
           sType = "Unknown control type"
   End Select
   TranslateControlType = sType

End Function 

</source>

Get the type of CommandBars

   <source lang="vb">

Sub listCommandBars() 

  Dim comBar As CommandBar
  Dim comBarType As String
  
  For Each comBar In CommandBars
     Select Case comBar.Type
     
     Case msoBarTypeNormal
       comBarType = "Toolbar"
     Case msoBarTypeMenuBar
       comBarType = "Menu Bar"
     Case msoBarTypePopup
       comBarType = "Shortcut"
     End Select
     
     Debug.Print comBar.Index, comBar.Name, comBarType, comBar.Visible
   Next

End Sub 

</source>

how your VBA code can change the position of a toolbar.

   <source lang="vb">

Sub MoveToolbar() 

   With CommandBars("MyToolbar")
       OldLeft = .Left
       OldTop = .Top
       For i = 1 To 60
           .Left = Int(vidWidth * Rnd)
           .Top = Int(vidHeight * Rnd)
           DoEvents
       Next i
       .Left = OldLeft
       .Top = OldTop
   End With

End Sub 

</source>

Inspecting a CommandBar

   <source lang="vb">

Sub DisplayGeneralInfo() 

   Dim cb As CommandBar 
   For Each cb In Application.rumandBars 
     Debug.Print "Name:" & cb.Name 
     Debug.Print "Index:" & cb.Index 
     Debug.Print "Built In:" & cb.BuiltIn 
     Debug.Print "Enabled:"  cb.Enabled 
     Debug.Print "Visible:" & cb.Visible 
     Debug.Print "Type:" & TranslateCommandBarType(cb.Type) 
     Debug.Print "Position:" & TranslateCommandBarPosition(cb.Position) 
     Debug.Print "Control Count:" & cb.Controls.Count 
   Next

End Sub
Function TranslateCommandBarPosition(vType As MsoBarPosition) As String 

   Dim sPosition As String 
   Select Case vType 
       Case Is = MsoBarPosition.msoBarBottom 
           sPosition = "Bottom" 
       Case Is = MsoBarPosition.msoBarFloating 
           sPosition = "Floating" 
       Case Is = MsoBarPosition.msoBarLeft 
           sPosition = "Left" 
       Case Is = MsoBarPosition.msoBarMenuBar 
               sPosition = "Menu Bar" 
       Case Is = MsoBarPosition.msoBarPopup 
           sPosition = "Popup" 
       Case Is = MsoBarPosition.msoBarRight 
           sPosition = "Right" 
       Case Is = MsoBarPosition.msoBarTop 
           sPosition = "Top" 
       Case Else 
           sPosition = "Unknown position" 
   End Select 
   TranslateCommandBarPosition = sPosition

End Function
Function TranslateCommandBarType(vType As MsoBarType) As String 

   Dim sType As String 
   Select Case vType 
       Case Is = MsoBarType.msoBarTypeMenuBar 
           sType = "Menu Bar" 
       Case Is = MsoBarType.msoBarTypeNormal 
           sType = "Normal" 
       Case Is = MsoBarType.msoBarTypePopup 
           sType = "Popup" 
       Case Else 
           sType = "Unknown type" 
   End Select 
   TranslateCommandBarType = sType

End Function 

</source>

Listing all controls on all toolbars

   <source lang="vb">

Sub ShowAllToolbarControls() 

   For Each myCommandBar In CommandBars
       If myCommandBar.Type = msoBarTypeNormal Then
           Debug.Print myCommandBar.name
           For Each ctl In myCommandBar.Controls
               Debug.Print ctl.Caption
           Next ctl
       End If
   Next myCommandBar

End Sub 

</source>

Listing the controls on a command bar

   <source lang="vb">

Sub ShowControlCaptions() 

   Dim myCommandBar As commandBar
   Set myCommandBar = CommandBars("Standard")
   For Each ctl In myCommandBar.Controls
       Debug.Print ctl.Caption
   Next ctl
</source>

Properties of CommandBar controls

   <source lang="vb">

Sub ShowShortcutMenuItems() 

 Dim myCommandBar As CommandBar
 Dim Ctl As CommandBarControl
 Application.ScreenUpdating = False
 For Each myCommandBar In Application.rumandBars
   If myCommandBar.Type = msoBarTypePopup Then
     Debug.Print  myCommandBar.Index
     Debug.Print  myCommandBar.Name
     For Each Ctl In myCommandBar.Controls
       If Ctl.Visible Then
         Debug.Print  Ctl.Caption
       Else
         Debug.Print  "<" & Ctl.Caption & ">"
       End If
    Next Ctl
  End If
 Next myCommandBar

End Sub 

</source>

Rather than use an index number to refer to a control, you can use its Caption property setting

   <source lang="vb">

Sub Test2() 

   MsgBox CommandBars("Standard").Controls("New").Caption

End Sub 

</source>

Referring to command bars

   <source lang="vb">

Function CommandBarExists(n) As Boolean 

   Dim cb As CommandBar
   For Each cb In CommandBars
       If UCase(cb.Name) = UCase(n) Then
           CommandBarExists = True
           Exit Function
       End If
   Next cb
   CommandBarExists = False

End Function 

</source>

Removes a toolbar specified by the name passed in

   <source lang="vb">

Sub RemoveToolbar(tlbarName As String) 

   Dim myCommandBar As CommandBar
   For Each myCommandBar In Application.rumandBars
       If myCommandBar.Name = tlbarName Then
           myCommandBar.Delete
           Exit For
       End If
   Next

End Sub 

</source>

Removing all toolbars and then restoring them

   <source lang="vb">

Sub HideAllToolbars() 

   Dim toolBar As commandBar
   Dim toolBarNum As Integer
   Dim toolBarSheet As Worksheet
   Set toolBarSheet = Sheets("Sheet1")
   Application.ScreenUpdating = False
   toolBarSheet.Cells.Clear
   
   toolBarNum = 0
   For Each toolBar In CommandBars
       If toolBar.Type = msoBarTypeNormal Then
           If toolBar.Visible Then
               toolBarNum = toolBarNum + 1
               toolBar.Visible = False
               toolBarSheet.Cells(toolBarNum, 1) = toolBar.name
           End If
       End If
   Next toolBar
   Application.ScreenUpdating = True

End Sub 

</source>
   
  


   <source lang="vb">

Sub MakeMenuBar() 

   Dim NewMenuBar As commandBar
   Set NewMenuBar = CommandBars.Add(MenuBar:=True)
   With NewMenuBar
       .name = "MyMenuBar"
       .Visible = True
   End With
   
   CommandBars("Worksheet Menu Bar") _
    .Controls(1).Copy Bar:=CommandBars("MyMenuBar")
   Set NewMenu = NewMenuBar.Controls.Add _
     (Type:=msoControlPopup)
   NewMenu.Caption = "&Commands"
   Set NewItem = NewMenu.Controls.Add(Type:=msoControlButton)
   With NewItem
       .Caption = "&Restore Normal Menu"
       .OnAction = "DeleteMenuBar"
   End With
   Set NewItem = NewMenu.Controls.Add(Type:=msoControlButton)
   With NewItem
       .Caption = "&Help"
       .OnAction = "DeleteMenuBar"
   End With

End Sub
Sub DeleteMenuBar() 

   On Error Resume Next
   CommandBars("MyMenuBar").Delete
   On Error GoTo 0

End Sub 

</source>

Reset CommandBar

   <source lang="vb">

Sub ResetAll() 

   Dim myCommandBar As CommandBar
   For Each myCommandBar In Application.rumandBars
       If myCommandBar.Type = msoBarTypePopup Then
           myCommandBar.Reset
           myCommandBar.Enabled = True
       End If
   Next myCommandBar

End Sub 

</source>
   
  


   <source lang="vb">

Private Sub ResetCommandBar() 

   Application.rumandBars("Worksheet Menu Bar").Reset

End Sub 

</source>

Restore tool bar

   <source lang="vb">

Sub RestoreToolbars() 

   Dim toolBarSheet As Worksheet
   Set toolBarSheet = Sheets("toolBarSheet")
   Application.ScreenUpdating = False
   On Error Resume Next
   For Each Cell In toolBarSheet.range("A:A") _
     .SpecialCells(xlCellTypeConstants)
       CommandBars(Cell.value).Visible = True
   Next Cell
   Application.ScreenUpdating = True

End Sub 

</source>

Save list of all predefined commands and their ID numbers in a file

   <source lang="vb">

Sub IdList() 

 On Error Resume Next
 If Application.Version >= 10# Then Exit Sub
 Dim c As CommandBar, i
 Set c = CommandBars.Add
 Open ThisWorkbook.Path + "CommandBar.txt" For Output As #1
 For i = 0 To 32
   c.Controls.Add Id:=i
   If c.Controls(1).Caption <> "" And _
      c.Controls(1).Caption <> "[Command not available]" And _
      c.Controls(1).Caption <> "custom" Then
     Print #1, i, c.Controls(1).Caption
   End If
   c.Controls(1).Delete
 Next i
 c.Delete
 Close #1

End Sub 

</source>

Set Control style, Action, group, faceid and caption

   <source lang="vb">

Sub AddNewMB() 

  Dim myCommandBar As CommandBar, myCommandBarCtl As CommandBarControl
  Dim myCommandBarSubCtl As CommandBarControl
  On Error GoTo AddNewMB_Err
  Set myCommandBar = CommandBars.Add(Name:="Sample Menu Bar", Position:= _
     msoBarTop, MenuBar:=True, Temporary:=False)
  myCommandBar.Visible = True
  myCommandBar.Protection = msoBarNoMove
  Set myCommandBarCtl = myCommandBar.Controls.Add(Type:=msoControlPopup)
  myCommandBarCtl.Caption = "Displa&y"
  Set myCommandBarSubCtl = myCommandBarCtl.Controls.Add(Type:=msoControlButton)
  With myCommandBarSubCtl
     .Style = msoButtonIconAndCaption
     .Caption = "S&ample Menu Disable"
     .FaceId = 59
     .OnAction = "=SampleMenuDisable()"
     .Parameter = 1
     .BeginGroup = True
  End With

AddNewMB_Err: 

  msgBox "Error " & Err.number & vbCr & Err.Description
  Exit Sub

End Sub
Function SampleMenuDisable() 

  Application.rumandBars("Sample Menu Bar").Visible = False
  Application.rumandBars("Menu Bar").Visible = True

End Function 

</source>

sets the FaceId property of the first button on the MyToolbar toolbar image to 45, which is the code number for a mailbox icon.

   <source lang="vb">

Sub faceID() 

   CommandBars("MyToolbar").Controls(1).FaceId = 45

End Sub 

</source>

Show All Toolbar Controls

   <source lang="vb">

Sub ShowAllToolbarControls() 

   Cells.Clear
   Row = 1
   For Each myCommandBar In CommandBars
       If myCommandBar.Type = msoBarTypeNormal Then
           Cells(Row, 1) = myCommandBar.Name
           For Each ctl In myCommandBar.Controls
               Cells(Row, 2) = ctl.Caption
               Row = Row + 1
           Next ctl
       End If
   Next myCommandBar

End Sub 

</source>

Show CommandBar Names

   <source lang="vb">

Sub ShowCommandBarNames() 

   Cells.Clear
   Row = 1
   For Each myCommandBar In CommandBars
       Cells(Row, 1) = myCommandBar.Index
       Cells(Row, 2) = myCommandBar.Name
       Select Case myCommandBar.Type
           Case msoBarTypeNormal
               Cells(Row, 3) = "Toolbar"
           Case msoBarTypeMenuBar
               Cells(Row, 3) = "Menu Bar"
           Case msoBarTypePopUp
               Cells(Row, 3) = "Shortcut"
       End Select
       Row = Row + 1
   Next myCommandBar

End Sub 

</source>

show/hide check symbol

   <source lang="vb">

Sub MenuCommand2_OnAction() 

 With CommandBars.ActionControl
   If .State = msoButtonDown Then
     .State = msoButtonUp
   Else
     .State = msoButtonDown
   End If
 End With

End Sub 

</source>

Shows or hides a command bar.

   <source lang="vb">

Sub TestCommandBarUtilities() 

   ShowCommandBar "Borders", True

End Sub
Sub ShowCommandBar(sName As String, bShow As Boolean) 

   If CommandBarExists(sName) Then 
       Application.rumandBars(sName).Visible = bShow 
   End If

End Sub 

</source>

simply copies the NumberFormat property of the ActiveCell to the Caption property of the button control.

   <source lang="vb">

Sub UpdateToolbar() 

   On Error Resume Next
   CommandBars("Number Format").Controls(1).Caption = ActiveCell.NumberFormat
   If Err <> 0 Then CommandBars("Number Format").Controls(1).Caption = ""

End Sub 

</source>

The custom toolbar is removed with this procedure

   <source lang="vb">

Sub RemoveToolBar() 

   On Error Resume Next
   Application.rumandBars("ExcelVBADummies").Delete

End Sub
Sub Main() 

 Debug.Print FirstName()

End Sub 

 Function FirstName()
      Dim FullName As String
      Dim FirstSpace As Integer
      FullName = Application.userName
      FirstSpace = InStr(FullName, " ")
      If FirstSpace = 0 Then
          FirstName = FullName
      Else
          FirstName = Left(FullName, FirstSpace - 1)
      End If
 End Function
</source>

The Protection constants are additive: apply different types of protection with a single command

   <source lang="vb">

Sub commandBar() 

   Set cb = CommandBars("MyToolbar")
   cb.Protection = msoBarNoCustomize + msoBarNoMove

End Sub 

</source>

The Protection property of a CommandBar object provides you with many options for protecting a CommandBar.

   <source lang="vb">

Sub commdBar() 

   CommandBars("MyToolbar").Protection = msoBarNoCustomize

End Sub 

</source>

This toolbar exists only when the cell pointer falls within a given range

   <source lang="vb">

Sub CreateToolbar() 

   Dim myBar As commandBar
   Dim Button As CommandBarButton
   
   Set myBar = CommandBars.Add
   For i = 1 To 4
       Set Button = myBar.Controls.Add(msoControlButton)
       With Button
           .OnAction = "Button" & i
           .FaceId = i + 37
       End With
   Next i
   myBar.name = "myBar"

End Sub 

</source>

To delete a control from a CommandBar object, use the Delete method of the Controls collection

   <source lang="vb">

Sub delBar() 

   CommandBars("MyToolbar").Controls(1).Delete

End Sub 

</source>

Translates a MsoBarPosition enumeration into a text description of the bar position.

   <source lang="vb">

Sub Inventory() 

   Dim cb As commandBar
   For Each cb In Application.rumandBars
       Debug.Print TranslateCommandBarPosition(cb.Position)
   Next
   Set cb = Nothing

End Sub
Function TranslateCommandBarPosition(vType As MsoBarPosition) As String 

   Dim sPosition As String
   Select Case vType
       Case Is = MsoBarPosition.msoBarBottom
           sPosition = "Bottom"
       Case Is = MsoBarPosition.msoBarFloating
           sPosition = "Floating"
       Case Is = MsoBarPosition.msoBarLeft
           sPosition = "Left"
       Case Is = MsoBarPosition.msoBarMenuBar
               sPosition = "Menu Bar"
       Case Is = MsoBarPosition.msoBarPopup
           sPosition = "Popup"
       Case Is = MsoBarPosition.msoBarRight
           sPosition = "Right"
       Case Is = MsoBarPosition.msoBarTop
           sPosition = "Top"
       Case Else
           sPosition = "Unknown position"
   End Select
   TranslateCommandBarPosition = sPosition

End Function 

</source>

Translates a MsoBarType enumeration into a text description of the bar type.

   <source lang="vb">

Sub Inventory() 

   Dim cb As commandBar
   For Each cb In Application.rumandBars
       Debug.Print TranslateCommandBarType(cb.Type)
   Next
   Set cb = Nothing

End Sub
Function TranslateCommandBarType(vType As MsoBarType) As String 

   Dim sType As String
   Select Case vType
       Case Is = MsoBarType.msoBarTypeMenuBar
           sType = "Menu Bar"
       Case Is = MsoBarType.msoBarTypeNormal
           sType = "Normal"
       Case Is = MsoBarType.msoBarTypePopup
           sType = "Popup"
       Case Else
           sType = "Unknown type"
   End Select
   TranslateCommandBarType = sType

End Function 

</source>

Translates a MsoControlType enumeration into a text description of the control type.

   <source lang="vb">

Private Sub DisplayControlDetail() 

   Dim cb As CommandBar 
   Dim cbc As CommandBarControl 
   On Error Resume Next 
   For Each cb In Application.rumandBars 
       For Each cbc In cb.Controls 
           Debug.Print cbc.Caption 
           Debug.Print TranslateControlType(cbc.Type) 
       Next 
   Next
   Set cbc = Nothing

End Sub
Function TranslateControlType(vType As MsoControlType) As String 

   Dim sType As String 
   Select Case vType 
       Case Is = MsoControlType.msoControlActiveX 
           sType = "ActiveX" 
       Case Is = MsoControlType.msoControlAutoCompleteCombo 
           sType = "Auto Complete Combo" 
       Case Is = MsoControlType.msoControlButton 
           sType = "Button" 
       Case Is = MsoControlType.msoControlButtonDropdown 
           sType = "Button Dropdown" 
       Case Is = MsoControlType.msoControlButtonPopup 
           sType = "Button Popup" 
       Case Is = MsoControlType.msoControlComboBox 
           sType = "Combo Box" 
       Case Is = MsoControlType.msoControlCustom 
           sType = "Custom" 
       Case Is = MsoControlType.msoControlDropdown 
           sType = "Dropdown" 
       Case Is = MsoControlType.msoControlEdit 
           sType = "Edit" 
       Case Is = MsoControlType.msoControlExpandingGrid 
           sType = "Expanding Grid" 
       Case Is = MsoControlType.msoControlGauge 
           sType = "Gauge" 
       Case Is = MsoControlType.msoControlGenericDropdown 
           sType = "Generic Dropdown" 
       Case Is = MsoControlType.msoControlGraphicCombo 
           sType = "Graphic Combo" 
       Case Is = MsoControlType.msoControlGraphicDropdown 
           sType = "Graphic Dropdown" 
       Case Is = MsoControlType.msoControlGraphicPopup 
           sType = "Graphic Popup" 
       Case Is = MsoControlType.msoControlGrid 
           sType = "Grid" 
       Case Is = MsoControlType.msoControlLabel 
           sType = "Label" 
       Case Is = MsoControlType.msoControlLabelEx 
           sType = "Label Ex" 
       Case Is = MsoControlType.msoControlOCXDropdown 
           sType = "OCX Dropdown" 
       Case Is = MsoControlType.msoControlPane 
           sType = "Pane" 
       Case Is = MsoControlType.msoControlPopup 
           sType = "Popup" 
       Case Is = MsoControlType.msoControlSpinner 
           sType = "Spinner" 
       Case Is = MsoControlType.msoControlSplitButtonMRUPopup 
           sType = "Split Button MRU Popup" 
       Case Is = MsoControlType.msoControlSplitButtonPopup 
           sType = "Split Button Popup" 
       Case Is = MsoControlType.msoControlSplitDropdown 
           sType = "Split Dropdown" 
       Case Is = MsoControlType.msoControlSplitExpandingGrid 
           sType = "Split Expanding Grid" 
       Case Is = MsoControlType.msoControlWorkPane 
           sType = "Work Pane" 
       Case Else 
           sType = "Unknown control type" 
   End Select 
   TranslateControlType = sType

End Function 

</source>
   
  


   <source lang="vb">

Sub ListShortCutMenus() 

   For Each myCommandBar In CommandBars
       If myCommandBar.Type = msoBarTypePopup Then
           Debug.Print myCommandBar.Index
           Debug.Print myCommandBar.name
           For col = 1 To myCommandBar.Controls.Count
               Debug.Print myCommandBar.Controls(col).Caption
           Next col
       End If
   Next myCommandBar

End Sub 

</source>
Источник
Basic Block List urn:microsoft.com/office/officeart/2005/8/layout/default Alternating Hexagons urn:microsoft.com/office/officeart/2008/layout/AlternatingHexagons Picture Caption List urn:microsoft.com/office/officeart/2005/8/layout/pList1 Lined List urn:microsoft.com/office/officeart/2008/layout/LinedList Vertical Bullet List urn:microsoft.com/office/officeart/2005/8/layout/vList2 Vertical Box List urn:microsoft.com/office/officeart/2005/8/layout/list1 Vertical Bracket List urn:diagrams.loki3.com/BracketList Varying Width List urn:diagrams.loki3.com/VaryingWidthList Tab List urn:microsoft.com/office/officeart/2011/layout/TabList Horizontal Bullet List urn:microsoft.com/office/officeart/2005/8/layout/hList1 Square Accent List urn:microsoft.com/office/officeart/2008/layout/SquareAccentList Picture Accent List urn:microsoft.com/office/officeart/2005/8/layout/hList2 Bending Picture Accent List urn:microsoft.com/office/officeart/2005/8/layout/bList2 Stacked List urn:microsoft.com/office/officeart/2005/8/layout/hList9 Increasing Circle Process urn:microsoft.com/office/officeart/2008/layout/IncreasingCircleProcess Pie Process urn:microsoft.com/office/officeart/2009/3/layout/PieProcess Detailed Process urn:microsoft.com/office/officeart/2005/8/layout/hProcess7 Grouped List urn:microsoft.com/office/officeart/2005/8/layout/lProcess2 Horizontal Picture List urn:microsoft.com/office/officeart/2005/8/layout/pList2 Continuous Picture List urn:microsoft.com/office/officeart/2005/8/layout/hList7 Picture Strips urn:microsoft.com/office/officeart/2008/layout/PictureStrips Vertical Picture List urn:microsoft.com/office/officeart/2005/8/layout/vList4 Alternating Picture Blocks urn:microsoft.com/office/officeart/2008/layout/AlternatingPictureBlocks Vertical Picture Accent List urn:microsoft.com/office/officeart/2005/8/layout/vList3 Titled Picture Accent List urn:microsoft.com/office/officeart/2008/layout/PictureAccentList Vertical Block List urn:microsoft.com/office/officeart/2005/8/layout/vList5 Vertical Chevron List urn:microsoft.com/office/officeart/2005/8/layout/chevron2 Vertical Accent List urn:microsoft.com/office/officeart/2008/layout/VerticalAccentList Vertical Arrow List urn:microsoft.com/office/officeart/2005/8/layout/vList6 Trapezoid List urn:microsoft.com/office/officeart/2005/8/layout/hList6 Descending Block List urn:microsoft.com/office/officeart/2009/3/layout/BlockDescendingList Table List urn:microsoft.com/office/officeart/2005/8/layout/hList3 Segmented Process urn:microsoft.com/office/officeart/2005/8/layout/process4 Vertical Curved List urn:microsoft.com/office/officeart/2008/layout/VerticalCurvedList Pyramid List urn:microsoft.com/office/officeart/2005/8/layout/pyramid2 Target List urn:microsoft.com/office/officeart/2005/8/layout/target3 Hierarchy List urn:microsoft.com/office/officeart/2005/8/layout/hierarchy3 Vertical Circle List urn:microsoft.com/office/officeart/2008/layout/VerticalCircleList Table Hierarchy urn:microsoft.com/office/officeart/2005/8/layout/hierarchy4 Architecture Layout urn:microsoft.com/office/officeart/2005/8/layout/architecture Basic Process urn:microsoft.com/office/officeart/2005/8/layout/process1 Step Up Process urn:microsoft.com/office/officeart/2009/3/layout/StepUpProcess Step Down Process urn:microsoft.com/office/officeart/2005/8/layout/StepDownProcess Accent Process urn:microsoft.com/office/officeart/2005/8/layout/process3 Picture Accent Process urn:microsoft.com/office/officeart/2005/8/layout/hProcess10 Alternating Flow urn:microsoft.com/office/officeart/2005/8/layout/hProcess4 Continuous Block Process urn:microsoft.com/office/officeart/2005/8/layout/hProcess9 Increasing Arrows Process urn:microsoft.com/office/officeart/2009/3/layout/IncreasingArrowsProcess Interconnected Block Process urn:microsoft.com/office/officeart/2011/layout/InterconnectedBlockProcess Continuous Arrow Process urn:microsoft.com/office/officeart/2005/8/layout/hProcess3 Converging Text urn:microsoft.com/office/officeart/2011/layout/ConvergingText Process Arrows urn:microsoft.com/office/officeart/2005/8/layout/hProcess6 Circle Accent Timeline urn:microsoft.com/office/officeart/2008/layout/CircleAccentTimeline Basic Timeline urn:microsoft.com/office/officeart/2005/8/layout/hProcess11 Circle Process urn:microsoft.com/office/officeart/2011/layout/CircleProcess Basic Chevron Process urn:microsoft.com/office/officeart/2005/8/layout/chevron1 Chevron Accent Process urn:microsoft.com/office/officeart/2005/8/layout/chevronAccent+Icon Closed Chevron Process urn:microsoft.com/office/officeart/2005/8/layout/hChevron3 Chevron List urn:microsoft.com/office/officeart/2005/8/layout/lProcess3 Sub-Step Process urn:microsoft.com/office/officeart/2009/3/layout/SubStepProcess Phased Process urn:microsoft.com/office/officeart/2009/3/layout/PhasedProcess Random to Result Process urn:microsoft.com/office/officeart/2009/3/layout/RandomtoResultProcess Vertical Process urn:microsoft.com/office/officeart/2005/8/layout/process2 Staggered Process urn:microsoft.com/office/officeart/2005/8/layout/vProcess5 Process List urn:microsoft.com/office/officeart/2005/8/layout/lProcess1 Circle Arrow Process urn:microsoft.com/office/officeart/2009/layout/CircleArrowProcess Basic Bending Process urn:microsoft.com/office/officeart/2005/8/layout/process5 Repeating Bending Process urn:microsoft.com/office/officeart/2005/8/layout/bProcess3 Vertical Bending Process urn:microsoft.com/office/officeart/2005/8/layout/bProcess4 Ascending Picture Accent Process urn:microsoft.com/office/officeart/2008/layout/AscendingPictureAccentProcess Upward Arrow urn:microsoft.com/office/officeart/2005/8/layout/arrow2 Descending Process urn:microsoft.com/office/officeart/2009/3/layout/DescendingProcess Circular Bending Process urn:microsoft.com/office/officeart/2005/8/layout/bProcess2 Equation urn:microsoft.com/office/officeart/2005/8/layout/equation1 Vertical Equation urn:microsoft.com/office/officeart/2005/8/layout/equation2 Funnel urn:microsoft.com/office/officeart/2005/8/layout/funnel1 Gear urn:microsoft.com/office/officeart/2005/8/layout/gear1 Arrow Ribbon urn:microsoft.com/office/officeart/2005/8/layout/arrow6 Opposing Arrows urn:microsoft.com/office/officeart/2005/8/layout/arrow4 Converging Arrows urn:microsoft.com/office/officeart/2005/8/layout/arrow5 Diverging Arrows urn:microsoft.com/office/officeart/2005/8/layout/arrow1 Basic Cycle urn:microsoft.com/office/officeart/2005/8/layout/cycle2 Text Cycle urn:microsoft.com/office/officeart/2005/8/layout/cycle1 Block Cycle urn:microsoft.com/office/officeart/2005/8/layout/cycle5 Nondirectional Cycle urn:microsoft.com/office/officeart/2005/8/layout/cycle6 Continuous Cycle urn:microsoft.com/office/officeart/2005/8/layout/cycle3 Multidirectional Cycle urn:microsoft.com/office/officeart/2005/8/layout/cycle7 Segmented Cycle urn:microsoft.com/office/officeart/2005/8/layout/cycle8 Basic Pie urn:microsoft.com/office/officeart/2005/8/layout/chart3 Hexagon Radial urn:microsoft.com/office/officeart/2011/layout/HexagonRadial Radial Cycle urn:microsoft.com/office/officeart/2005/8/layout/radial6 Basic Radial urn:microsoft.com/office/officeart/2005/8/layout/radial1 Diverging Radial urn:microsoft.com/office/officeart/2005/8/layout/radial5 Radial Venn urn:microsoft.com/office/officeart/2005/8/layout/radial3 Cycle Matrix urn:microsoft.com/office/officeart/2005/8/layout/cycle4 Radial Cluster urn:microsoft.com/office/officeart/2008/layout/RadialCluster Organization Chart urn:microsoft.com/office/officeart/2005/8/layout/orgChart1 Picture Organization Chart urn:microsoft.com/office/officeart/2005/8/layout/pictureOrgChart+Icon Name and Title Organization Chart urn:microsoft.com/office/officeart/2008/layout/NameandTitleOrganizationalChart Half Circle Organization Chart urn:microsoft.com/office/officeart/2008/layout/HalfCircleOrganizationChart Circle Picture Hierarchy urn:microsoft.com/office/officeart/2009/layout/CirclePictureHierarchy Hierarchy urn:microsoft.com/office/officeart/2005/8/layout/hierarchy1 Labeled Hierarchy urn:microsoft.com/office/officeart/2005/8/layout/hierarchy6 Horizontal Organization Chart urn:microsoft.com/office/officeart/2009/3/layout/HorizontalOrganizationChart Horizontal Multi-Level Hierarchy urn:microsoft.com/office/officeart/2008/layout/HorizontalMultiLevelHierarchy Horizontal Hierarchy urn:microsoft.com/office/officeart/2005/8/layout/hierarchy2 Horizontal Labeled Hierarchy urn:microsoft.com/office/officeart/2005/8/layout/hierarchy5 Balance urn:microsoft.com/office/officeart/2005/8/layout/balance1 Circle Relationship urn:microsoft.com/office/officeart/2009/3/layout/CircleRelationship Hexagon Cluster urn:microsoft.com/office/officeart/2008/layout/HexagonCluster Opposing Ideas urn:microsoft.com/office/officeart/2009/3/layout/OpposingIdeas Plus and Minus urn:microsoft.com/office/officeart/2009/3/layout/PlusandMinus Reverse List urn:microsoft.com/office/officeart/2009/layout/ReverseList Counterbalance Arrows urn:microsoft.com/office/officeart/2005/8/layout/arrow3 Segmented Pyramid urn:microsoft.com/office/officeart/2005/8/layout/pyramid4 Nested Target urn:microsoft.com/office/officeart/2005/8/layout/target2 Converging Radial urn:microsoft.com/office/officeart/2005/8/layout/radial4 Radial List urn:microsoft.com/office/officeart/2005/8/layout/radial2 Tabbed Arc urn:diagrams.loki3.com/TabbedArc+Icon Basic Target urn:microsoft.com/office/officeart/2005/8/layout/target1 Basic Venn urn:microsoft.com/office/officeart/2005/8/layout/venn1 Linear Venn urn:microsoft.com/office/officeart/2005/8/layout/venn3 Stacked Venn urn:microsoft.com/office/officeart/2005/8/layout/venn2 Interconnected Rings urn:microsoft.com/office/officeart/2005/8/layout/rings+Icon Basic Matrix urn:microsoft.com/office/officeart/2005/8/layout/matrix3 Titled Matrix urn:microsoft.com/office/officeart/2005/8/layout/matrix1 Grid Matrix urn:microsoft.com/office/officeart/2005/8/layout/matrix2 Basic Pyramid urn:microsoft.com/office/officeart/2005/8/layout/pyramid1 Inverted Pyramid urn:microsoft.com/office/officeart/2005/8/layout/pyramid3 Accented Picture urn:microsoft.com/office/officeart/2008/layout/AccentedPicture Circular Picture Callout urn:microsoft.com/office/officeart/2008/layout/CircularPictureCallout Radial Picture List urn:microsoft.com/office/officeart/2011/layout/RadialPictureList Snapshot Picture List urn:microsoft.com/office/officeart/2009/3/layout/SnapshotPictureList Spiral Picture urn:microsoft.com/office/officeart/2009/3/layout/SpiralPicture Captioned Pictures urn:microsoft.com/office/officeart/2008/layout/CaptionedPictures Bending Picture Caption urn:microsoft.com/office/officeart/2008/layout/BendingPictureCaption Picture Frame urn:microsoft.com/office/officeart/2011/layout/Picture Frame Bending Picture Semi-Transparent Text urn:microsoft.com/office/officeart/2008/layout/BendingPictureSemiTransparentText Bending Picture Blocks urn:microsoft.com/office/officeart/2008/layout/BendingPictureBlocks Bending Picture Caption List urn:microsoft.com/office/officeart/2008/layout/BendingPictureCaptionList Titled Picture Blocks urn:microsoft.com/office/officeart/2008/layout/TitledPictureBlocks Picture Grid urn:microsoft.com/office/officeart/2008/layout/PictureGrid Picture Accent Blocks urn:microsoft.com/office/officeart/2008/layout/PictureAccentBlocks Theme Picture Accent urn:microsoft.com/office/officeart/2011/layout/ThemePictureAccent Theme Picture Grid urn:microsoft.com/office/officeart/2011/layout/ThemePictureGrid Theme Picture Alternating Accent urn:microsoft.com/office/officeart/2011/layout/ThemePictureAlternatingAccent Alternating Picture Circles urn:microsoft.com/office/officeart/2008/layout/AlternatingPictureCircles Title Picture Lineup urn:microsoft.com/office/officeart/2008/layout/TitlePictureLineup Picture Lineup urn:microsoft.com/office/officeart/2008/layout/PictureLineup Framed Text Picture urn:microsoft.com/office/officeart/2009/3/layout/FramedTextPicture Bubble Picture List urn:microsoft.com/office/officeart/2008/layout/BubblePictureList
Источник

You can create custom VBA word menus and you can add to existing
menus. On this page we will see how you add a new menu called favorite
to the main Word menu bar.

Here is the code if you want to copy it…

Sub AddCustomMenu()
    Dim cbMenuBar As CommandBar
    Dim idHelp As Integer
    Dim cbcNewMenu As CommandBarControl
        Set cbMenuBar = Application.CommandBars("Menu Bar")
    idHelp = cbMenuBar.Controls("Help").Index
    On Error Resume Next
    Application.CommandBars("Menu Bar").Controls("Fa&vorite").Delete
    On Error GoTo 0
    Set cbcNewMenu = cbMenuBar.Controls.Add _
                        (msoControlPopup, , , idHelp)
    cbcNewMenu.Caption = "Fa&vorite"
    With cbcNewMenu.Controls.Add(Type:=msoControlButton)
                    .Caption = "Properties"
                    .OnAction = "ShowProperties"
    End With
    With cbcNewMenu.Controls.Add(Type:=msoControlButton)
                    .Caption = "Record"
                    .OnAction = "RecordMacro"
    End With
End Sub
Sub InsertBreak()
    Selection.InsertBreak wdPageBreak
End Sub
Sub InsertTime()
    Selection.InsertDateTime DateTimeFormat:="HH:mm", InsertAsField:=False, _
        DateLanguage:=wdEnglishUS, CalendarType:=wdCalendarWestern, _
        InsertAsFullWidth:=False
End Sub

Here is how it works…

The variable cbMenuBar is set to the main Word menu bar which is called «Menu Bar».

Set cbMenuBar = Application.CommandBars(«Menu Bar»)

I got its name by running this code…

For Each cb In Application.CommandBars
    Debug.Print cb.Name
Next

…to see all the Command Bar names.

Next, we save the ID of the help mean since we will need to supply a value to the Before parameter for the Controls.Add function…

idHelp = cbMenuBar.Controls(«Help»).Index

Next we delete the button if it was previously added so as not to create a second, third, etc.

On Error Resume Next
Application.CommandBars(«Menu Bar»).Controls(«Fa&vorite»).Delete
On Error GoTo 0

Next we set the CommandBarControl variable to a new control using the Help menu’s ID for the before parameter…

Set cbcNewMenu = cbMenuBar.Controls.Add(msoControlPopup, , , idHelp)

We then give the control a caption…

cbcNewMenu.Caption = «Fa&vorite»

the «&» before the «v» will let us activate the menu with ALT + v.

We then add two items to the menu…

With cbcNewMenu.Controls.Add(Type:=msoControlButton)
                .Caption = "Properties"
                .OnAction = "ShowProperties"
End With
With cbcNewMenu.Controls.Add(Type:=msoControlButton)
                .Caption = "Record"
                .OnAction = "RecordMacro"
End With

The two macros at the end will be run respectively when a menu
item is chosen. You can write your own macros or record them, including
recording the built-in menu items as was done for this tutorial.

You can also create submenus in your VBA Word menus.

This
site is powered by Site Build It!. If you enjoy it, please check out
the
Site
Build It homepage to learn more and on how to build
a success-guaranteed site with no technical skills.

Google

Custom
Search

Return from VBA Word Menus to «VBA Code Samples»

Return from VBA Word menus to our «Home Page»

Источник

Понравилась статья? Поделить с друзьями:
  • Vba word activedocument close
  • Vba with word 2010
  • Vba with word 2007
  • Vba with microsoft word
  • Vba with excel book