Like this article? We recommend
Like this article? We recommend
Like this article? We recommend
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