SOLVED

Countdown slide in Slide show

Copper Contributor

I have a PPSM file that I am running on a kiosk computer 24/7.  There is one slide that I am counting down to a future date and I am trying to get it to update automatically and not having much luck.  I was wondering if anyone had any advice on how to get this work so that I do not have to go in everyday to update one slide.

 

I am using this code to "trigger" the slide update:

Public Sub OnSlideShowPageChange(ByVal Wn As SlideShowWindow)
   If Wn.View.CurrentShowPosition = 1 Then
       Countdown
   End If
End Sub

and then this is what I am using to update the slide:

Sub Countdown()

    Dim Days As Date
    'Launch date
    Days = DateSerial(2022, 2, 14)

    ActivePresentation.Slides(1).Shapes("countdown").TextFrame.TextRange = "Countdown to" & vbCrLf & "Valentines " & vbCrLf & DateDiff("d", Now(), Days) & " Days"
        ActivePresentation.Slides(1).Shapes("countdown") _
        .TextFrame.TextRange.Characters(14, 2).Font.Name = "Nobel-Bold"
        ActivePresentation.Slides(1).Shapes("countdown") _
        .TextFrame.TextRange.Characters(25, 8).Font.Size = 120
        ActivePresentation.Saved = True
        
End Sub

Any advice would be appreciated.  Thank you!!

 

1 Reply
best response confirmed by Opal55 (Copper Contributor)
Solution

I have changed the "trigger" to the following on the slide that plays just before the slide I want to update:

Private Sub App_SlideShowNextSlide(ByVal Wn As SlideShowWindow)
   Dim Showpos As Integer
   Showpos = Wn.View.CurrentShowPosition + 1
        If Showpos = 1 Then
            Countdown
                End If
End Sub

This appears to be working.  If I get any errors, I will post back to this thread.  I still welcome any advice.  Thank you.

1 best response

Accepted Solutions
best response confirmed by Opal55 (Copper Contributor)
Solution

I have changed the "trigger" to the following on the slide that plays just before the slide I want to update:

Private Sub App_SlideShowNextSlide(ByVal Wn As SlideShowWindow)
   Dim Showpos As Integer
   Showpos = Wn.View.CurrentShowPosition + 1
        If Showpos = 1 Then
            Countdown
                End If
End Sub

This appears to be working.  If I get any errors, I will post back to this thread.  I still welcome any advice.  Thank you.

View solution in original post