Announcement

Collapse
No announcement yet.

Create Floating Toolbar (not Menu)

Collapse
This topic is closed.
X
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Create Floating Toolbar (not Menu)



    A few days ago a knowledgeable Ozgrid member, RoyUk, was kind enough to help me with sample code to create a custom floating menu which appears on opening the workbook. It works brilliantly, but I'd like to adapt it so that I can create a floating toolbar, which is fully expanded upon opening, where the button faces are plain text which I designate.

    Let's suppose the macros I want the buttons to trigger are called MacroA and MacroB, and that the text on the buttons should read "Do A" and "Do B".

    I'd appreciate any help; my knowledge of VBA code at present is meager. Perhaps it would be easiest for you and me both if you could help by placing the code in the context of his code (see below) with the odd comment to steer me as to what's going on.

    His code appears here

    http://www.ozgrid.com/forum/showthread.php?t=62665

    It's in Item #10

    but for convenience here his code which goes in a) a standard module and b) the ThisWorkbook module.

    a) code for a standard module

    Code:
    Sub Create_Menu()
        Dim MyBar As CommandBar
        Dim MyPopup As CommandBarPopup
        Dim MyButton As CommandBarButton
         
        Delete_Menu 'make sure commandbar isn't already running
         
        Set MyBar = CommandBars.Add(Name:="My Menu", _
        Position:=msoBarFloating, temporary:=True)
         
        With MyBar
            .Top = 175
            .Left = 850
             
            Set MyPopup = .Controls.Add(Type:=msoControlPopup)
            With MyPopup
                .Caption = "My Tools" 'change to suit
                .BeginGroup = True
                Set MyButton = .Controls.Add(Type:=msoControlButton)
                With MyButton
                    .Caption = "yellow" 'this the text
                    .Style = msoButtonCaption
                     ''' msoButtonAutomatic, msoButtonIcon, msoButtonCaption, or msoButtonIconandCaption
                    .BeginGroup = True
                    .OnAction = "yellow" 'macro to be run,change to EmailSLA
                End With
                 'this code to add another button
                Set MyButton = .Controls.Add(Type:=msoControlButton)
                With MyButton
                    .Caption = "chicken"
                    .Style = msoButtonCaption
                    .BeginGroup = False
                    .OnAction = "chicken"
                End With
            End With
             
            .Width = 150
            .Visible = True
        End With
         
    End Sub
     
    Sub Delete_Menu()
        On Error Resume Next
        CommandBars("My Menu").Delete
        On Error GoTo 0
    End Sub
    Sub MyMacro()
        MsgBox "Your macro"
         
    End Sub

    b) code for the ThisWorkbook module.

    Code:
    Option Explicit
    
    Private Sub Workbook_BeforeClose(Cancel As Boolean)
        Call Delete_Menu
    End Sub
     
    Private Sub Workbook_Open()
        Call Create_Menu
    End Sub

  • #2
    Re: Create Floating Toolbar (not Menu)

    I am withdrwaing this question so that I can seek help elsewhere without contraneing the crosspost ban.

    Roy, thanks for the code you provided, it makes menus very well, but what I've been asking for is how to make toolbars with buttons.

    Comment


    • #3
      Re: Create Floating Toolbar (not Menu)

      You misunderstand crossposting- you can crosspost, but add a link in both Forums.
      Hope that Helps

      Roy

      New users should read the Forum Rules before posting

      For free Excel tools & articles visit my web site

      RoyUK's Web Site

      royUK's Database Form

      Where to paste code from the Forum

      About me.

      Comment


      • #4
        Re: Create Floating Toolbar (not Menu)

        Maybe this is what you want - a floating toolbar with two buttons

        Code:
        Option Explicit
        
        Const sCB      As String = "My Tools"
        Sub MyCB()
            On Error Resume Next
            Application.CommandBars(sCB).Delete
            On Error GoTo 0
        
            With Application.CommandBars.Add(sCB, , False, True)
        
                With .Controls.Add(msoControlButton)
                    .TooltipText = "Chicken"
                    .FaceId = 1017
                    .OnAction = "hicken"
                    .BeginGroup = True
                End With
        
                With .Controls.Add(msoControlButton)
                    .TooltipText = "Yellow"
                    .FaceId = 1018
                    .OnAction = "yellow"
                End With
                .Protection = msoBarNoCustomize
                .Position = msoBarFloating
                .Visible = True
            End With
        End Sub
        
        
        Sub MenuDelete()
            On Error Resume Next
            Application.CommandBars(sCB).Delete
            On Error GoTo 0
        End Sub
        Hope that Helps

        Roy

        New users should read the Forum Rules before posting

        For free Excel tools & articles visit my web site

        RoyUK's Web Site

        royUK's Database Form

        Where to paste code from the Forum

        About me.

        Comment


        • #5
          Re: Create Floating Toolbar (not Menu)

          Thanks for the clarification Roy.

          Meanwhile I have learned a solution which I'll share here for any other similarly green VBA newbies.

          This is an example for creating an on-the-fly toolbar which is created on opening, and deleted on closing, the workbook.

          In this example the toolbar buttons trigger three simple example macros, called

          The buttons on the toolbar are simple text buttons. After some meditation I decided to label them "Yellow", "Red" and "Chicken".

          Paste this code in the ThisWorkbook module:

          Code:
          Option Explicit
          
          Private Sub Workbook_Activate()
            Call ShowToolbar(True)
          End Sub
          
          Private Sub Workbook_BeforeClose(Cancel As Boolean)
            Call DeleteToolbar
          End Sub
          
          Private Sub Workbook_Deactivate()
            Call ShowToolbar(False)
          End Sub
          
          Private Sub Workbook_Open()
            Call CreateToolBar
          End Sub
          and paste this in a standard module:

          Code:
          Option Explicit
          
          Public Const strToolbar = "My Toolbar"
          
          Sub CreateToolBar()
            Dim cbr As CommandBar
            Dim cbb As CommandBarButton
          
            On Error Resume Next
          
            CommandBars(strToolbar).Delete
          
            On Error GoTo ErrHandler
          
            Set cbr = CommandBars.Add(strToolbar)
            With cbr
              .Position = msoBarTop
              .Visible = True
            End With
          
            Set cbb = cbr.Controls.Add(msoControlButton)
            With cbb
              .Caption = "Yellow"
              .OnAction = "Yellow"
              .Style = msoButtonCaption
              .Visible = True
            End With
          
            Set cbb = cbr.Controls.Add(msoControlButton)
            With cbb
              .Caption = "Chicken"
              .OnAction = "Chicken"
              .Style = msoButtonCaption
              .Visible = True
            End With
          
            Set cbb = cbr.Controls.Add(msoControlButton)
            With cbb
              .Caption = "Red"
              .OnAction = "Red"
              .Style = msoButtonCaption
              .Visible = True
            End With
            
          ExitHandler:
            Set cbb = Nothing
            Set cbr = Nothing
            Exit Sub
          
          ErrHandler:
            MsgBox Err.Description, vbExclamation
            Resume ExitHandler
          End Sub
          
          Sub DeleteToolbar()
            On Error Resume Next
            CommandBars(strToolbar).Delete
          End Sub
          
          Sub ShowToolbar(f As Boolean)
            On Error Resume Next
            CommandBars(strToolbar).Visible = f
          End Sub
          
          ''here is the real ground-breaking stuff
          
          Sub Yellow()
          '
          ' Yellow Macro
          ' Macro recorded 11/01/2007 by Samsung
          '
          
          '
              Cells.Select
              With Selection.Interior
                  .ColorIndex = 6
                  .Pattern = xlSolid
              End With
          End Sub
          Sub Red()
          '
          ' Red Macro
          ' Macro recorded 11/01/2007 by Samsung
          '
          
          '
              Range("A1").Select
              Selection.Font.ColorIndex = 3
          End Sub
          Sub Chicken()
          '
          ' Chicken Macro
          ' Macro recorded 11/01/2007 by Samsung
          '
          
          '
              Range("A1").Select
              ActiveCell.FormulaR1C1 = "Chicken"
              Range("A2").Select
          End Sub
          Save, close, reopen and volia! Yellow! Red! Chicken!

          Comment


          • #6
            Re: Create Floating Toolbar (not Menu)

            Your example creates a fixed or docked toolbar, my last post is a floating toolbar which is what I thought that you wanted. Anyway, there are now examples for most types that may be required.
            Hope that Helps

            Roy

            New users should read the Forum Rules before posting

            For free Excel tools & articles visit my web site

            RoyUK's Web Site

            royUK's Database Form

            Where to paste code from the Forum

            About me.

            Comment


            • #7


              Re: Create Floating Toolbar (not Menu)

              I have since found on the web an example of a variant -- code which creates floating command bar with "sub-pop-ups". It is here

              http://peltiertech.com/Excel/menus.html

              Comment

              Working...
              X