Add Shape overlay with action and send to back

[Paul_Hossler]

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

[John Wilson]

Have a look at this demo with annotated code

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

[John Wilson]

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

[Paul_Hossler]

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



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

[John Wilson]

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.

[John Wilson]

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/

[Paul_Hossler]

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

13843 13843 13843 13843

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


BTW -- regarding this ...


.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

[John Wilson]

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

13853

[Paul_Hossler]

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

[John Wilson]

It won't.