|
Microsoft PowerPoint MVP
2003-2007
| |
So, you are running a show in dual screen mode and George,
the guy in charge of the child care room, comes up and asks you to get Mr. &
Mrs. Smith right now, 'cause Jimmy had an accident. Pop Quiz, what do you
do?
You don't want to interrupt everything and announce over
the PA that a kid is hurt. No parent in the audience will hear another
word that is said. In addition, the mood the presenter has been carefully
building, is now shattered. Announcements are just ugly solutions.
Enter in this little pair of macros:
- The first macro pauses the show and asks what needs to be
shown, then displays it.
- The second removes the display. Having this
removal as a separate macro allows you to keep the message up as long or as
short a time as is required.
So, add shortcuts to this pair of macros (ShowMe and HideMe) on any toolbar and click on one to
add your message and the other to remove it.
Please note that these macros are not fool-proof. I have not trapped possible
errors, like removing messages that are not there, or adding messages on to
existing messages. You can add these routines should you feel the need.
Option Explicit
Sub ShowMe()
Dim Msg As String, Sld As Integer, x As Integer
Msg = InputBox("What do you want to be displayed?", "Urgent Message")
If Trim(Msg) = "" Then Exit Sub
Sld = SlideShowWindows(1).View.CurrentShowPosition
ActivePresentation.Slides(Sld).Shapes _
.AddTextbox(msoTextOrientationHorizontal, _
Left:=0, Top:=-50, Width:=ActivePresentation _
.PageSetup.SlideWidth, Height:=50).Name = "Emergent"
With ActivePresentation.Slides(Sld).Shapes("Emergent")
With .Fill
.ForeColor.RGB = RGB(255,
0, 0)
.OneColorGradient
msoGradientHorizontal, 4, 0
End With
With .TextFrame.TextRange
.ParagraphFormat.Alignment
= ppAlignCenter
.Text = Msg
.Font.Size = 35
.Font.Color.RGB =
RGB(255, 240, 240)
End With
For x = -50 To 0
.Top = x
DoEvents
Next x
.Copy
End With
For x = 1 To ActivePresentation.Slides.Count
If x <> Sld Then
ActivePresentation.Slides(x).Shapes.Paste
End If
Next x
SlideShowWindows(1).Activate
End Sub
Sub HideMe()
Dim x As Integer, y As Integer, Sld As Integer
Sld = ActivePresentation.SlideShowWindow.View.CurrentShowPosition
For x = 1 To ActivePresentation.Slides.Count
With
ActivePresentation.Slides(x).Shapes("Emergent")
If x = Sld Then
For y = 0 To -50 Step -1
.Top = y
DoEvents
Next y
End If
.Delete
End With
Next x
SlideShowWindows(1).Activate
End Sub
|
|
