Private Sub cmdPowerPoint_Click()
'--- declare any required objects and variables
Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim ppCurrentSlide As PowerPoint.Slide
'--- open powerpoint and set a pointer from Access to it
Set ppApp = CreateObject("PowerPoint.Application")
'--- make it visible on your monitor
ppApp.Visible = True
'--- open the pre-designed template
Set ppPres = ppApp.Presentations.Open("C:/METRICS.ppt")
Dim x
x = 0
Recordset.MoveFirst
Do Until Recordset.EOF
x = x + 1
'**********First Slide of data************'
'--- set a pointer to the first slide in the presentation
Set ppCurrentSlide = ppPres.SLIDES(x)
'--- assign a custom string of text to the slide title
ppCurrentSlide.Shapes("UnitName").TextFrame.TextRange.Text = UnitName.Value
ppCurrentSlide.Shapes("UnitName").TextFrame.TextRange.Text = UnitName.Value
ppCurrentSlide.Shapes("AsOfDate").TextFrame.TextRange.Text = Format(AsOfDate.Value, "Medium Date")
ppCurrentSlide.Shapes("Assigned").TextFrame.TextRange.Text = Assigned.Value
ppCurrentSlide.Shapes("Overall").TextFrame.TextRange.Text = Overall.Value
ppCurrentSlide.Shapes("OverallP").TextFrame.TextRange.Text = OverallP.Value
ppCurrentSlide.Shapes("PHA").TextFrame.TextRange.Text = PHA.Value
ppCurrentSlide.Shapes("PHAP").TextFrame.TextRange.Text = PHAP.Value
ppCurrentSlide.Shapes("Dental").TextFrame.TextRange.Text = Dental.Value
ppCurrentSlide.Shapes("DentalP").TextFrame.TextRange.Text = DentalP.Value
ppCurrentSlide.Shapes("Immunizations").TextFrame.TextRange.Text = Immunizations.Value
ppCurrentSlide.Shapes("ImmunizationsP").TextFrame.TextRange.Text = ImmunizationsP.Value
ppCurrentSlide.Shapes("LabTests").TextFrame.TextRange.Text = LabTests.Value
ppCurrentSlide.Shapes("LabTestsP").TextFrame.TextRange.Text = LabTestsP.Value
ppCurrentSlide.Shapes("MaskFitTest").TextFrame.TextRange.Text = MaskFitTest.Value
ppCurrentSlide.Shapes("MaskFitTestP").TextFrame.TextRange.Text = MaskFitTestP.Value
ppCurrentSlide.Shapes("Inserts").TextFrame.TextRange.Text = Inserts.Value
ppCurrentSlide.Shapes("InsertsP").TextFrame.TextRange.Text = InsertsP.Value
ppCurrentSlide.Shapes("NotonProfile").TextFrame.TextRange.Text = NotonProfile.Value
ppCurrentSlide.Shapes("NotonProfileP").TextFrame.TextRange.Text = NotonProfileP.Value
ppCurrentSlide.Shapes("OccHealth").TextFrame.TextRange.Text = OccHealth.Value
ppCurrentSlide.Shapes("OccHealthP").TextFrame.TextRange.Text = OccHealthP.Value
ppCurrentSlide.Shapes("CATM").TextFrame.TextRange.Text = CATM.Value
ppCurrentSlide.Shapes("CATMP").TextFrame.TextRange.Text = CATMP.Value
ppCurrentSlide.Shapes("CWDT").TextFrame.TextRange.Text = CWDT.Value
ppCurrentSlide.Shapes("CWDTP").TextFrame.TextRange.Text = CWDTP.Value
ppCurrentSlide.Shapes("SABC").TextFrame.TextRange.Text = SABC.Value
ppCurrentSlide.Shapes("SABCP").TextFrame.TextRange.Text = SABCP.Value
ppCurrentSlide.Shapes("Fitness").TextFrame.TextRange.Text = Fitness.Value
ppCurrentSlide.Shapes("FitnessP").TextFrame.TextRange.Text = FitnessP.Value
ppCurrentSlide.Shapes("LegalReadiness").TextFrame.TextRange.Text = LegalReadiness.Value
ppCurrentSlide.Shapes("LegalReadinessP").TextFrame.TextRange.Text = LegalReadinessP.Value
ppCurrentSlide.Shapes("UNITTOTAL").TextFrame.TextRange.Text = UNITTOTAL.Value
ppCurrentSlide.Shapes("UNITTOTALP").TextFrame.TextRange.Text = UNITTOTALP.Value
ppCurrentSlide.Shapes("UNITCOMMENTS").TextFrame.TextRange.Text = UNITCOMMENTS.Value
Recordset.MoveNext
Loop
'--- remove the pointers from memory
Set ppApp = Nothing
Set ppPres = Nothing
Set ppCurrentSlide = Nothing
End Sub