The key to this process is the click event in the Access form. The code that's fired during the event calculates the winner based on the values in the form, and then decides which of 24 PowerPoint slides to show in a preset PowerPoint file.
Figure 4 shows the PowerPoint file in Slide Sorter view. It's not hard to create such a file by using Insert, Duplicate Slide once you've constructed the elements; even the custom animation will follow along to the next slide, and you just need to change the order to determine the winner, moving the clip art representing each team to the proper position in the slide.
Figure 4 With 24 possible combinations of finishes for any given medal ceremony, you create a PowerPoint file with the team names, and let Access determine which slide to show.
You can even change the names of the teams from one venue to another by using a simple search-and-replace to change the current team names to the new team names. The key is saving the file under the proper name. Obviously, the key to this process is the macro code in the Present button (see Figure 5).
Figure 5 The macro code behind the button creates several variables and determines which slide to project in a predetermined PowerPoint file.
Here's the code shown when I select right-click the Present button in the form's design view and choose Build Event:
Option Compare Database Option Explicit Private Sub Command10_Click() Dim Gold As String Dim Silver As String Dim Bronze As String Dim SlideNo As Long ' Dim MySlide As PowerPoint.SlideRange Dim Results ' Dim MyForm As Form Dim a As Integer Dim b As Integer Dim c As Integer Dim d As Integer ' get the values of the Team scores a = Me.TeamA.Value b = Me.TeamB.Value c = Me.TeamC.Value d = Me.TeamD.Value If a = 3 Then Gold = "A" If b = 3 Then Gold = "B" If c = 3 Then Gold = "C" If d = 3 Then Gold = "D" If a = 2 Then Silver = "A" If b = 2 Then Silver = "B" If c = 2 Then Silver = "C" If d = 2 Then Silver = "D" If a = 1 Then Bronze = "A" If b = 1 Then Bronze = "B" If c = 1 Then Bronze = "C" If d = 1 Then Bronze = "D" Results = Gold & Silver & Bronze Debug.Print Results ' Select the slide number to play If Results = "ABC" Then SlideNo = 1 If Results = "ACB" Then SlideNo = 2 If Results = "ABD" Then SlideNo = 3 If Results = "ADB" Then SlideNo = 4 If Results = "ACD" Then SlideNo = 5 If Results = "ADC" Then SlideNo = 6 If Results = "BCD" Then SlideNo = 7 If Results = "BDC" Then SlideNo = 8 If Results = "BAC" Then SlideNo = 9 If Results = "BCA" Then SlideNo = 10 If Results = "BAD" Then SlideNo = 11 If Results = "BDA" Then SlideNo = 12 If Results = "CAB" Then SlideNo = 13 If Results = "CBA" Then SlideNo = 14 If Results = "CAD" Then SlideNo = 15 If Results = "CDA" Then SlideNo = 16 If Results = "CBD" Then SlideNo = 17 If Results = "CDB" Then SlideNo = 18 If Results = "DCB" Then SlideNo = 19 If Results = "DCB" Then SlideNo = 20 If Results = "DAB" Then SlideNo = 21 If Results = "DBA" Then SlideNo = 22 If Results = "DAC" Then SlideNo = 23 If Results = "DCA" Then SlideNo = 24 ' Play the slide numbered from the case Dim objPP As PowerPoint.Application Dim ppPres As PowerPoint.Presentation ' Dim ppName As String ' ppName = "C:\olympics\automation" ' Turn hourglass on. Screen.MousePointer = 11 ' Resume to the next line following the error. On Error Resume Next ' Attempt to reference PowerPoint which is already running. Set objPP = GetObject(, "PowerPoint.Application") ' If true, PowerPoint is not running. If objPP Is Nothing Then ' Create a new instance of the PowerPoint application. Set objPP = New PowerPoint.Application ' If true, MS PowerPoint is not installed. If objPP Is Nothing Then MsgBox "MS PowerPoint is not installed on your computer" End If End If ' On Error GoTo ErrorHandler (Put Error Handler Code Here!) ' ppPres. Filename:="C:\olympics\automation.ppt" ' objPP.Presentations.Pr ' objPP.Presentations.Open (ppName) ' Set ppPres = objPP.Presentations.Open("C:\olympics\automation.ppt") objPP.WindowState = ppWindowMaximized ' Turn hourglass off. Screen.MousePointer = 0 ' Show PowerPoint to the user. objPP.Visible = True ' ActivePresentation.Windows.Item(1).Activate ' Presentations.Open Filename:="C:\olympics\automation.ppt", ReadOnly:=msoFalse objPP.Presentations.Open ("c:\olympics\automation.ppt") ' objPP.ActiveWindow.ViewType = ppViewSlideSorter ' objPP.ActivePresentation.Slides.Range(SlideNo).Select With objPP.ActivePresentation.SlideShowSettings .ShowType = ppShowTypeSpeaker ' .LoopUntilStopped = msoFalse ' .ShowWithNarration = msoFalse ' .ShowWithAnimation = msoTrue .RangeType = ppShowSlideRange .StartingSlide = SlideNo .EndingSlide = SlideNo ' .RangeType = ppShowAll ' .AdvanceMode = ppSlideShowUseSlideTimings ' .PointerColor.SchemeColor = ppForeground .Run End With Set objPP = Nothing End Sub Private Sub report_Click() On Error GoTo Err_report_Click Dim stDocName As String stDocName = "report" DoCmd.RunMacro stDocName Exit_report_Click: Exit Sub Err_report_Click: MsgBox Err.Description Resume Exit_report_Click End Sub