WD98: Sample Macro to Create Popup Toolbar

MORE INFORMATION

  Sub CreatePopupToolbarExample()

      Dim cbToolBar As CommandBar
      Dim cbMenuBar As CommandBarPopup
      Dim cbSuBMnu1 As CommandBarButton
      Dim cbSuBMnu2 As CommandBarPopup
      Dim cbSuBMnu2_PopUp As CommandBarButton
      Dim strToolBar As String
      Dim iCount As Integer

      ' Replace "My Toolbar" with a name
      ' you want to use for your toolbar.
      strToolBar = "My Toolbar"

      ' If a toolbar of this name already exists,
      ' append a number to the end of name to
      ' differentiate one from the other.
      For Each cbToolBar In CommandBars
         If Left$(cbToolBar.Name, Len(strToolBar)) = strToolBar Then
            iCount = iCount + 1
         End If
      Next

      If iCount > 0 Then strToolBar = strToolBar & iCount

      ' Create and display the Toolbar.
      Set cbToolBar = CommandBars.Add(Name:=strToolBar, _
         Position:=msoBarFloating)
      cbToolBar.Visible = True

      ' Create Main PopUp Menu on Toolbar.
      Set cbMenuBar = cbToolBar.Controls.Add(Type:=msoControlPopup)
      cbMenuBar.Caption = "Main Menu"

      ' Add a Menu Button and a Popup
      ' Menu to the "Main PopUp Menu."
      With cbMenuBar.Controls
         Set cbSuBMnu1 = .Add(Type:=msoControlButton)
         Set cbSuBMnu2 = .Add(Type:=msoControlPopup)
      End With

      ' Set properties for the sub
      ' button and popup menus.
      With cbSuBMnu1
         .Caption = "Sub Menu 1 (Button)"
         .Style = msoButtonCaption
         .OnAction = "ButtonAction1" ' <- Macro to run when clicked.
      End With
      With cbSuBMnu2
         .Caption = "Sub Menu 2 (Popup)"
      End With

      ' Add Popup menu to Sub Menu 2
      With cbSuBMnu2.Controls
         Set cbSuBMnu2_PopUp = .Add(Type:=msoControlButton)
      End With
      With cbSuBMnu2_PopUp
         .Caption = "Popup 1"
         .OnAction = "ButtonAction2" ' <- Macro to run when clicked.
      End With
   End Sub
				

   Sub ButtonAction1()
      MsgBox "Button Click."
   End Sub

   Sub ButtonAction2()
      MsgBox "Pop Up Button Click."
   End Sub