Create a new Ribbon tab with vba that only appears selecting certain shapes

Question

I want to make appear a new ribbon tab that only appears when I select a shape that I want. I know to make normal tabs using Custom UI Editor For Microsoft Office or also with VBA using the following example:

Dim oToolbar As CommandBar
    Dim oButton As CommandBarButton
    Dim MyToolbar As String

    ' Give the toolbar a name
    MyToolbar = "Kewl Tools"

    On Error Resume Next
    ' so that it doesn't stop on the next line if the toolbar's already there

    ' Create the toolbar; PowerPoint will error if it already exists
    Set oToolbar = CommandBars.Add(Name:=MyToolbar, _
        Position:=msoBarFloating, Temporary:=True)
    If Err.Number <> 0 Then
          ' The toolbar's already there, so we have nothing to do
          Exit Sub
    End If

    On Error GoTo ErrorHandler

    ' Now add a button to the new toolbar
    Set oButton = oToolbar.Controls.Add(Type:=msoControlButton)

    ' And set some of the button's properties

    With oButton

         .DescriptionText = "This is my first button"
          'Tooltip text when mouse if placed over button

         .Caption = "Do Button1 Stuff"
         'Text if Text in Icon is chosen

         .OnAction = "Button1"
          'Runs the Sub Button1() code when clicked

         .Style = msoButtonIcon
          ' Button displays as icon, not text or both

         .FaceId = 52
          ' chooses icon #52 from the available Office icons

    End With

    ' Repeat the above for as many more buttons as you need to add
    ' Be sure to change the .OnAction property at least for each new button

    ' You can set the toolbar position and visibility here if you like
    ' By default, it'll be visible when created. Position will be ignored in PPT 2007 and later
    oToolbar.top = 150
    oToolbar.left = 150
    oToolbar.Visible = True

 NormalExit:
    Exit Sub   ' so it doesn't go on to run the errorhandler code

 ErrorHandler:
     'Just in case there is an error
     MsgBox Err.Number & vbCrLf & Err.Description
     Resume NormalExit:

But I want to make it appear and disappear in certain moments. For example in Powerpoint when you select a video, there appears 2 new tabs (FORMAT AND PLAYBACK) with options for videos. When you select another shape that is not video this tab just disappear and other tabs appears with the proper options for the shape that you select and when you don't select any shape those special tabs just disappear.

Is it possible to make it using VBA?

Answer 1

Yes this is possible. There are three main things you need to implement to make this occur.

1. Enable Events in the add-in to capture the selection of a shape. When the shape selection event fires, this will be called to determine if the shape is what you want to show your tab etc.
2. In the XML that defines the ribbon ensure you have a 'Visible' callback function.
3. VBA code for the callback function of 'Visible'.

For example

In a module named 'Ribbon'

Private theRibbon As IRibbonUI 'Holds a variable for the ribbon when loaded on startup
Private MyTag As String        'A variable to tell the ribbon to show or what Tag to hide

'Callback for the Ribbon loading from XML
Public Sub RibbonOnLoad(Ribbon As IRibbonUI)
    Set theRibbon = Ribbon
    MyTag = "show"
End Sub

'Get visible callback function.
Sub GetVisible(control As IRibbonControl, ByRef visible)
    If MyTag = "show" Then
        visible = True
    Else
        If control.Tag Like MyTag Then
            visible = True
        Else
            visible = False
        End If
    End If
End Sub

'This is a custom sub that invalidates the ribbon as needed.  
'When invalidated it has to redraw itself
Sub RefreshRibbon(Tag As String)
    MyTag = Tag
    If theRibbon Is Nothing Then
        MsgBox "Error, Save/Restart your presentation"
    Else
        theRibbon.Invalidate
    End If
End Sub

In a module named 'Events'

'Define the new events class
Dim cPPTEvent As New clsEvents

Sub Auto_Open()
    'Enable the events when the aad-in is loaded
    Set cPPTEvent.PPTEvent = Application
End Sub

Sub Auto_Close()
    'Disable when it is closed
    Set cPPTEvent.PPTEvent = Nothing
    Set cPPTEvent = Nothing
End Sub

In a class module named 'clsEvents'. This will check the shapes in the range and if any are of the movie media type the tab will be shown on the ribbon, otherwise it'll be hidden.

Public WithEvents PPTEvent As Application

Private Sub PPTEvent_WindowSelectionChange(ByVal Sel As Selection)
    Dim ppCurShape As PowerPoint.Shape

    If Sel.Type = ppSelectionNone Then
        RefreshRibbon ""
        Exit Sub
    End If

    For Each ppCurShape In Sel.ShapeRange
        If ppCurShape.Type = msoMedia Then
            If ppCurShape.MediaType = ppMediaTypeMovie Then
                RefreshRibbon "show"
                Exit Sub
            End If
        End If
    Next

    RefreshRibbon ""
End Sub

And of course the ribbon XML code (taken from the first reference down the bottom)

    <customUI onLoad="RibbonOnLoad" xmlns="http://schemas.microsoft.com/office/2006/01/customui">
      <ribbon>
        <tabs>
          <tab id="MyCustomTab" label="My Tab" insertAfterMso="TabHome" getVisible="GetVisible" tag="MyPersonalTab" >
           <group id="customGroup1" label="Group 1">
              <button id="customButton1" label="Caption 1" size="normal" onAction="Macro1" imageMso="DirectRepliesTo" />
              <button id="customButton2" label="Caption 2" size="normal" onAction="Macro2" imageMso="AccountMenu" />
              <button id="customButton3" label="Caption 3" size="normal" onAction="Macro3" imageMso="RegionLayoutMenu" />
            </group>
            <group id="customGroup2" label="Group 2">
              <button id="customButton4" label="Caption 4" size="normal" onAction="Macro4" imageMso="TextAlignGallery" />
              <button id="customButton5" label="Caption 5" size="normal" onAction="Macro5" imageMso="PrintPreviewClose" />
              <button id="customButton6" label="Caption 6" size="normal" onAction="Macro6" imageMso="PrintPreviewShrinkOnePage" />
              <separator id="MySeparator1" />
              <button id="customButton7" label="Caption 7" size="large" onAction="Macro7" imageMso="ReviewPreviousComment" />
            </group>
            <group id="customGroup3" label="Group 3">
              <menu id="MyDropdownMenu" label="My Menu" size="large" imageMso="TextAlignGallery"  >
                <button id="customButton8" label="Caption 8"  onAction="Macro8" imageMso="TextAlignGallery" />
                <button id="customButton9" label="Caption 9"  onAction="Macro9" imageMso="TextAlignGallery" />
                <button id="customButton10" label="Caption 10"  onAction="Macro10" imageMso="TextAlignGallery" />
                <button id="customButton11" label="Caption 11"  onAction="Macro11" imageMso="TextAlignGallery" />
                <button id="customButton12" label="Caption 12"  onAction="Macro12" imageMso="TextAlignGallery" />
              </menu>
            </group>
          </tab>
        </tabs>
      </ribbon>
    </customUI>

For more reading:

• Hiding the tabs and controls: http://msdn.microsoft.com/en-us/library/ee390805%28v=office.11%29#odc_office2007_DisplayHideRibbonControls_ChangingVisibilityRibbonTabs
• Powerpoint events (thanks Steve): http://www.pptfaq.com/FAQ00004_Make_your_VBA_code_in_PowerPoint_respond_to_events.htm
• List of events you can capture: http://officeone.mvps.org/vba/events_version.html