Home > Articles

  • Print
  • + Share This
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 4Figure 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 5Figure 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
  • + Share This
  • 🔖 Save To Your Account