Powerpoint VBA: Help Needed

[Kevie192]

Hi all,



I'm trying to write some code to update a scoreboard on a few slides of a presentation using VBA but I'm getting a bit stuck and wondered if anyone can see what I'm doing wrong?

This part works absolutely fine:

 
Sub OnSlideShowPageChange(ByVal SSW As SlideShowWindow)

    If SSW.View.CurrentShowPosition = 8 Then
Dim Team1Scr As String
Dim Team2Scr As String
Team1Scr = InputBox("Enter Team 1 Score:", "Scores")
ActivePresentation.Slides(8).Shapes("Scr1").TextFrame.TextRange.Text = Team1Scr
Team2Scr = InputBox("Enter Team 2 Score:", "Scores")
ActivePresentation.Slides(8).Shapes("Scr2").TextFrame.TextRange.Text = Team2Scr
SendKeys ("{ENTER}")

End If
    
End Sub

But, I need events for more than one slide, so I've tried adding in an ElseIf and it now doesn't show the boxes on any of the slides:

Sub OnSlideShowPageChange(ByVal SSW As SlideShowWindow)
 
    If SSW.View.CurrentShowPosition = 8 Then
Dim Team1Scr As String
Dim Team2Scr As String
Team1Scr = InputBox("Enter Team 1 Score:", "Scores")
ActivePresentation.Slides(8).Shapes("Scr1").TextFrame.TextRange.Text = Team1Scr
Team2Scr = InputBox("Enter Team 2 Score:", "Scores")
ActivePresentation.Slides(8).Shapes("Scr2").TextFrame.TextRange.Text = Team2Scr
SendKeys ("{ENTER}")
 
ElseIf SSW.View.CurrentShowPosition = 16 Then
Dim Team1Scr As String
Dim Team2Scr As String
Team1Scr = InputBox("Enter Team 1 Score:", "Scores")
ActivePresentation.Slides(16).Shapes("Scr1").TextFrame.TextRange.Text = Team1Scr
Team2Scr = InputBox("Enter Team 2 Score:", "Scores")
ActivePresentation.Slides(16).Shapes("Scr2").TextFrame.TextRange.Text = Team2Scr
SendKeys ("{ENTER}")
    
End If
    
End Sub

Any ideas?

Many thanks,

Kevin

[JohnWilson]

You shouldn't have duplicate declarations in one module.

Try this using Select case

Sub OnSlideShowPageChange(ByVal SSW As SlideShowWindow)
Dim Team1Scr As String
Dim Team2Scr As String
Select Case SSW.View.CurrentShowPosition

Case Is = 8
Team1Scr = InputBox("Enter Team 1 Score:", "Scores")
ActivePresentation.Slides(8).Shapes("Scr1").TextFrame.TextRange.Text = Team1Scr
Team2Scr = InputBox("Enter Team 2 Score:", "Scores")
ActivePresentation.Slides(8).Shapes("Scr2").TextFrame.TextRange.Text = Team2Scr

 
Case Is = 16
Team1Scr = InputBox("Enter Team 1 Score:", "Scores")
ActivePresentation.Slides(16).Shapes("Scr1").TextFrame.TextRange.Text = Team1Scr
Team2Scr = InputBox("Enter Team 2 Score:", "Scores")
ActivePresentation.Slides(16).Shapes("Scr2").TextFrame.TextRange.Text = Team2Scr
    
End Select
    
End Sub

A word of warning OnSlideShowPageChange is NOT a reliable method and not supported/documented by Microsoft. Before using it in an important setting try saving, close PowerPoint and reopen. Does it still work??

I've removed theSendKeys lines. What were they for? The effect would be to move on to the next slide or animation.