Add Shape overlay with action and send to back

I'm trying to write a PP 2010 macro to do some formatting in slide edit mode

1. add a rectangle shape covering the entire slide named "Invisible_Back"

2. no fill and no border

3. send to back (I'll need a flavor to send to front but I should be able to do that myself)

4. add action to hyperlink to a particular slide


Hand crafted example, done the hard way

Slide one has Invisible_Back so that if one of the Shapes is not clicked, it stays, instead of advancing to next slide

Slide one has shapes with action to a shape-specific slide

Each shape specific slide has a Invisible_Front overlay to return to the main slide (slide one) no matter where you click


I'll probable expand the macro to apply Invisible_Front to all selected slides instead on one at a time


I haven't figured out how I want to handle assigning actions to the shapes on Slide one yet

Have a look at this demo with annotated code

(EDIT it should say in the notes "To DO this properly ...")

I was also wondering why not just untick "On Mouse Click" Transition?

Thanks for the help -- incorporated your code into my working test. I'll play with it some more, and then add the macros to my general purpose add-in

Never even occurred to me to untick the advance on mouse click

The goal is to make a PP slide show with a main 'driver' slide that will branch to others, but return to the main slide. I've had bad luck doing that sort of stuff with action buttons, since I forget in the heat of presenting and just click the slide. This was just to make it a little more fool proof for me

I did add some support routines (temporarily add SlideID to each slide, delete them, etc.)

Expanded to SlideRange to do multiples

Code:

---

Option Explicit

Sub SlideID_Add()
    Dim oSlide As Slide
    Dim oShape As Shape
   
    If ActivePresentation Is Nothing Then Exit Sub
   
    For Each oSlide In ActivePresentation.Slides
        On Error Resume Next
        oSlide.Shapes("SlideID").Delete
        On Error GoTo 0
       
        With oSlide.Shapes.AddShape(msoShapeRectangle, 0, 0, 100, 20)
            .Name = "SlideID"
            .Fill.ForeColor.RGB = RGB(255, 0, 0)
            .Line.ForeColor.RGB = RGB(0, 0, 0)
            With .TextFrame.TextRange
                .Text = CStr(oSlide.SlideID)
                .Font.Name = "arial"
                .Font.Size = 8
                .Font.Color.RGB = RGB(0, 0, 0)
            End With
        End With
    Next
End Sub
Sub SlideID_Delete()
    Dim oSlide As Slide
    Dim oShape As Shape
   
    If ActivePresentation Is Nothing Then Exit Sub
   
    For Each oSlide In ActivePresentation.Slides
        On Error Resume Next
        oSlide.Shapes("SlideID").Delete
        On Error GoTo 0
    Next
End Sub

Sub Overlay_AddFront()
    Call pvtOverlayAdd(True)
End Sub
Sub Overlay_AddBack()
    Call pvtOverlayAdd(False)
End Sub
Sub Overlays_Delete()
    Dim oSlide As Slide
    Dim oShape As Shape
   
    If ActivePresentation Is Nothing Then Exit Sub
   
    For Each oSlide In ActivePresentation.Slides
        On Error Resume Next
        oSlide.Shapes("Foreground Overlay").Delete
        oSlide.Shapes("Background Overlay").Delete
        On Error GoTo 0
    Next
End Sub
 
Private Sub pvtOverlayAdd(ForeGround As Boolean)
    Dim oSlideLink As Slide
    Dim vSlideID As Variant
    Dim sLinkID As String, sLinkIndex As String, sLinkTitle As String
    Dim oSlideRange As SlideRange
    Dim iSlideRange As Long
    Dim eZorder As MsoZOrderCmd
    Dim sOverlay As String
   
   
    If ActivePresentation Is Nothing Then Exit Sub
   
    If ForeGround Then
        eZorder = msoBringToFront
        sOverlay = "Foreground Overlay"
    Else
        eZorder = msoSendToBack
        sOverlay = "Background Overlay"
    End If
   
    vSlideID = InputBox("Enter the SlideID of the slide for the " & sOverlay & " to link to", sOverlay, 0)
    If Len(vSlideID) = 0 Then Exit Sub
   
    Set oSlideLink = Nothing
    On Error Resume Next
    Set oSlideLink = ActivePresentation.Slides.FindBySlideID(CLng(vSlideID))
    On Error GoTo 0
   
    If oSlideLink Is Nothing Then
        Call MsgBox("'" & vSlideID & "' is not a valid slide ID. Try again", vbCritical + vbOKOnly, "Add Mask")
        Exit Sub
    End If
   
   
    Set oSlideRange = ActiveWindow.Selection.SlideRange
   
    For iSlideRange = 1 To oSlideRange.Count
       
        With oSlideRange(iSlideRange)
            On Error Resume Next
            .Shapes(sOverlay).Delete
            On Error GoTo 0
       
            With .Shapes.AddShape(msoShapeRectangle, 0, 0, ActivePresentation.PageSetup.SlideWidth, ActivePresentation.PageSetup.SlideHeight)
               
                .Name = sOverlay
                .Fill.Visible = False
                .Line.Visible = False
                .ZOrder (eZorder)
               
                sLinkID = CStr(oSlideLink.SlideID)
                sLinkIndex = CStr(oSlideLink.SlideIndex)
                Select Case oSlideLink.Shapes.HasTitle
                    Case Is = True
                        If oSlideLink.Shapes.Title.TextFrame.HasText Then
                            sLinkTitle = oSlideLink.Shapes.Title.TextFrame.TextRange
                        Else
                            sLinkTitle = "Slide " & CStr(oSlideLink.SlideIndex)
                        End If
                    Case Is = False
                        sLinkTitle = "Slide " & CStr(oSlideLink.SlideIndex)
                    End Select
       
                With .ActionSettings(ppMouseClick)
                    .Action = ppActionHyperlink
                    .Hyperlink.SubAddress = sLinkID & "," & sLinkIndex & "," & sLinkTitle
                End With
            End With
        End With
    Next
End Sub

---

Glad it worked OK.

Just to clear sub address up for others reading and maybe using "shortcuts"

In SOME versions if you simply set the sub address to eg "4" it will link to slide 4. However if you then check the sub address you will see that PPT has automatically modified it to something like "284,4,Slide 4". In other versions you can set the sub address to eg "284,," and it works. I would always set the proper full sub address "ID,Index,Title" especially if your users may not have the same version as you.

BTW we are in New Orleans running the Presentation Summit Help desk with Steve Rindsberg end of September. Long way from Pennsylvania but it really is the best conference going if your company will pay for you! Also you owe me a beer or two ;-)

http://www.betterpresenting.com/summit/

Thanks for the invite -- I retired last year, so no more expense account.

I do a little 'work' but my wife (teacher professor at local college) is working towards a doctorate and there's a lot of PP and presenting involved with that.

Some of the guys from the office stay in touch for some free consulting, mostly Excel

But you're right-- this is the least I can do for your help

Attachment 13843 Attachment 13843 Attachment 13843 Attachment 13843

:friends: Hope it's your brand :beerchug:


BTW -- regarding this ...

Code:

---

.Hyperlink.SubAddress = sLinkID & "," & sLinkIndex & "," & sLinkTitle

---

I realize I need to add a Refresh sub since slide titles (and maybe indexes) can change, so I need to use the SlideID to refresh the link just for safety's sake

As long as the slide ID is correct I'm pretty sure it always works. The sub address does not update when you move / delete slides but it still works.

I was brought up near Marstons but I guess I've been corrupted by many visits to the US

Attachment 13853

Quote:

---

The sub address does not update when you move / delete slides but it still works.

---

I was mostly concern about changing the slide title causing a disconnect

It won't.