Display message in Slide Show
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.
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
© 2022 Better Solutions Limited. All Rights Reserved. © 2022 Better Solutions Limited TopPrev