Announcement

Collapse
No announcement yet.

Custom UI Ribbon - favorites - Dropdown

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Custom UI Ribbon - favorites - Dropdown



    Handy worksheet navigation dropdown box for those annoying multi-worksheet workbooks

    Ribbon Code
    PHP Code:
    <!--RibbonX Visual Designer 2.31 for Microsoft Excel CustomUI14 XML Code produced on 2016/11/25-->
    <
    customUI  Onload="RibbonOnLoad" xmlns="http://schemas.microsoft.com/office/2009/07/customui" >
        <
    ribbon >
            <
    tabs >
                <
    tab 
                    id
    ="Tab1"
                    
    insertBeforeMso="TabHome"
                    
    label="My Menu">
                    <
    group 
                                  id
    ="grpDropDowns"
                        
    label="Worksheet Navigation">
                        <
    dropDown 
                            id
    ="SheetNavigation"
                            
    label="Navigate to:"
                            
    sizeString="WWWWWWWWWW"
                            
    supertip="Go to Worksheet Selected in Dropdown "
                            
    getItemCount="getItemCount"
                            
    getItemLabel="getItemLabel" 
                            
    getSelectedItemIndex="GetSelectedItemIndexDropDown"
                            
    onAction="onAction"/>
                    </
    group >
                </
    tab >
            </
    tabs >
        </
    ribbon >
    </
    customUI 

    In module vba
    Code:
    Option Explicit
    Dim Rib As IRibbonUI
    Private mwkbNavigation As Workbook
    Sub getItemCount(control As IRibbonControl, ByRef returnedVal)
        Dim lCount As Long
        Dim wksSheet As Worksheet
        Set mwkbNavigation = ThisWorkbook
        For Each wksSheet In mwkbNavigation.Worksheets
            If wksSheet.visible = xlSheetVisible Then
                lCount = lCount + 1
            End If
        Next wksSheet
        returnedVal = lCount
    End Sub
    Sub GetSelectedItemIndexDropDown(control As IRibbonControl, ByRef index)
      index = ActiveSheet.index - 1
    End Sub
    Sub getItemLabel(control As IRibbonControl, index As Integer, ByRef returnedVal)
        If mwkbNavigation.Worksheets(index + 1).visible = xlSheetVisible Then
            returnedVal = mwkbNavigation.Worksheets(index + 1).Name
        End If
    End Sub
    Sub onAction(control As IRibbonControl, id As String, index As Integer)
        Dim sSheetName As String
        sSheetName = mwkbNavigation.Worksheets(index + 1).Name
        mwkbNavigation.Worksheets(sSheetName).Activate
    End Sub
    Sub RibbonOnLoad(ribbon As IRibbonUI)
        Set Rib = ribbon
    End Sub
    Last edited by pike; June 11th, 2017, 19:52. Reason: add Onload="RibbonOnLoad
    If the solution helped please donate to RSPCA

    Sites worth visiting: Rabbitohs | Excel-it royUK | Excel Matters Rory | Kris' Spreadsheet Solutions | Domenic xl-central | SO The Macro Man | The Smallman

  • #2
    Re: Custom UI Ribbon - favorites

    Thanks for this, very neat.
    We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

    Comment


    • #3
      Re: Custom UI Ribbon - favorites - Dropdown

      Handy when your come across workbooks with ten or more worksheets
      If the solution helped please donate to RSPCA

      Sites worth visiting: Rabbitohs | Excel-it royUK | Excel Matters Rory | Kris' Spreadsheet Solutions | Domenic xl-central | SO The Macro Man | The Smallman

      Comment


      • #4
        Re: Custom UI Ribbon - favorites - Dropdown

        This is a very useful - Thanks Pike

        I need this as an AddIn which was saved as such
        Problems are as an AddIn:


        1. Dropdown content doesn't update when workbooks are opened and closed
        2. Will throw errors when sheets are not found that were populated in the dropdown from prior sheets or initial OnOpen
        3. Last, I'm looking for a way to add a scrollbar when a large number of sheets exceeds the page size - dropdown extends below the bottom of the screen


        Any help would be much appreciated

        Comment


        • #5
          Re: Custom UI Ribbon - favorites - Dropdown

          Not to sure how to fixit until the workbook changes are saved and reopened.
          With that many worksheets and combobox would be better!
          If the solution helped please donate to RSPCA

          Sites worth visiting: Rabbitohs | Excel-it royUK | Excel Matters Rory | Kris' Spreadsheet Solutions | Domenic xl-central | SO The Macro Man | The Smallman

          Comment


          • #6
            Re: Custom UI Ribbon - favorites - Dropdown

            For dynamic combobox
            PHP Code:
            <!--RibbonX Visual Designer 2.31 for Microsoft Excel CustomUI14 XML Code produced on 2017/06/11-->
            <
            customUI onLoad="RibbonOnLoad"
              
            xmlns="http://schemas.microsoft.com/office/2009/07/customui" >
                <
            ribbon >
                    <
            tabs >
                        <
            tab 
                            id
            ="Tab1"
                            
            insertBeforeMso="TabHome"
                            
            label="RDS Design Manual Menu">
                            <
            group 
                                id
            ="grpDropDowns"
                                
            label="Worksheet Navigation">
                                <
            comboBox 
                                    id
            ="Combobox1"
                                    
            label="goto"
                                    
            getItemCount="Combobox1_getItemCount"
                                    
            getItemID="Combobox1_getItemID"
                                    
            getItemLabel="Combobox1_getItemLabel"
                                    
            onChange="Combobox1_onChange"/>
                            </
            group >
                        </
            tab >
                    </
            tabs >
                </
            ribbon >
            </
            customUI 
            module code
            Code:
            Option Explicit
            Dim Rib As IRibbonUI
            Dim mwkbNavigation As Workbook
            Sub RibbonOnLoad(ribbon As IRibbonUI)
                Set Rib = ribbon
            End Sub
            Public Sub Combobox1_getItemCount(control As IRibbonControl, ByRef returnedVal)
                Dim lCount As Long
                Dim wksSheet As Worksheet
                Set mwkbNavigation = ThisWorkbook
                For Each wksSheet In mwkbNavigation.Worksheets
                    If wksSheet.visible = xlSheetVisible Then
                        lCount = lCount + 1
                    End If
                Next wksSheet
                returnedVal = lCount
            End Sub
            Public Sub Combobox1_getItemLabel(control As IRibbonControl, index As Integer, ByRef returnedVal)
                If mwkbNavigation.Worksheets(index + 1).visible = xlSheetVisible Then
                    returnedVal = mwkbNavigation.Worksheets(index + 1).Name
                End If
            End Sub
            Public Sub Combobox1_onChange(control As IRibbonControl, Text As String)
                Worksheets(Text).Activate
                RefreshAddInsRibbon
            End Sub
            Public Sub RefreshAddInsRibbon()
                If Rib Is Nothing Then Exit Sub
                Rib.InvalidateControl ("Combobox1")
                DoEvents
            End Sub
            
            Public Sub Combobox1_getItemID(control As IRibbonControl, index As Integer, ByRef id)
            '
            ' Code for getItemID callback. Ribbon control comboBox
            '
            
            End Sub
            workbook module
            Code:
            Option Explicit
            Private Sub Workbook_NewSheet(ByVal Sh As Object)
                RefreshAddInsRibbon
            End Sub
            Private Sub Workbook_SheetBeforeDelete(ByVal Sh As Object)
                RefreshAddInsRibbon
            End Sub
            Private Sub Workbook_SheetActivate(ByVal Sh As Object)
                RefreshAddInsRibbon
            End Sub
            Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
                RefreshAddInsRibbon
            End Sub
            If the solution helped please donate to RSPCA

            Sites worth visiting: Rabbitohs | Excel-it royUK | Excel Matters Rory | Kris' Spreadsheet Solutions | Domenic xl-central | SO The Macro Man | The Smallman

            Comment


            • #7


              Hi all,
              UI custom have three possible option on where to add your custom tools and buttons.
              The Tab "Ribbon" option, the File "Backstage" menu option and/or the right click "ContextMenus" option can all be very helpful
              PHP Code:
              <customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"

              <
              ribbon>

              <
              tabs>

              <
              tab id="highlightTab"

              label="Unit Assembly Menu" 

              insertBeforeQ="TabFormat">

              <
              group id="testGroup"

              label="Test">

              <
              button id="highlightManualTasks"

              label="Toggle Manual Task Color"

              imageMso="DiagramTargetInsertClassic"

              onAction="ToggleManualTasksColor"/>

              </
              group

              </
              tab>

              </
              tabs>

              </
              ribbon

              <
              backstage>

              <
              tab

              id
              ="customTab"

              label="Assembly Units">

              <
              firstColumn>

              <
              group

              id
              ="customGroup"

              label="Assembly Units">

              <
              topItems>

              <
              button 

              id
              ="customButton"

              label=" Load &amp;&amp; Return"

              imageMso="BevelShapeGallery"

              onAction="OnAction"

              isDefinitive="true" />

              </
              topItems

              </
              group>

              </
              firstColumn>

              </
              tab

              </
              backstage>

              @

              <
              contextMenus>

              <
              contextMenu idMso="ContextMenuCell"

              <
              dynamicMenu

              id
              ="MyDynamicMenu"

              label"My Assembly Unit Menu" 

              imageMso="HappyFace"

              getContent="GetContent"

              insertBeforeMso="Cut"/> 

              <
              menuSeparator id="MySeparator" insertBeforeMso="Cut" /> 

              </
              contextMenu>

              </
              contextMenus

              </
              customUI
              Code:
              Option Explicit
              Sub OnAction(control As IRibbonControl)
                  MsgBox "Assembly Units"
              End Sub
              Sub GetContent(control As IRibbonControl, ByRef returnedVal)
                  Dim xml As String
              
                  xml = "<menu xmlns=""http://schemas.microsoft.com/office/2009/07/customui"">" & _
                        "<button id=""but1"" imageMso=""Help"" label=""Help"" onAction=""HelpMacro""/>" & _
                        "<button id=""but2"" imageMso=""FindDialog"" label=""Find"" onAction=""FindMacro""/>" & _
                        "</menu>"
                  returnedVal = xml
              End Sub
              
              Sub HelpMacro(control As IRibbonControl)
                  MsgBox "Help macro"
              End Sub
              
              Sub FindMacro(control As IRibbonControl)
                  MsgBox "Find macro"
              End Sub
              Sub ToggleManualTasksColor(control As IRibbonControl)
               MsgBox "Assembly Units"
              End Sub
              Attached Files
              If the solution helped please donate to RSPCA

              Sites worth visiting: Rabbitohs | Excel-it royUK | Excel Matters Rory | Kris' Spreadsheet Solutions | Domenic xl-central | SO The Macro Man | The Smallman

              Comment

              Working...
              X