Export Access Report to PowerPoint Slide

[Kristoph]

Hello,

I would like to export an existing Access report, MyReport, to a PowerPoint template so that it shows up in the PowerPoint presentation just like you were viewing it as a SnapShot. Thus far I am able to export record sets to a PowerPoint template, but have not been able to embed an actual report. Here is the code I have found so far that works very well for record sets....

Any advice is appreciated, thank you!!

Original source of this code is MSDN (I imagine it's okay to post this source?):

http://msdn.microsoft.com/en-us/library/aa159920(office.11).aspx

Code:

Sub cmdPowerPoint_Click()
Dim db As Database, rs As Recordset
Dim ppObj As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation

On Error GoTo err_cmdOLEPowerPoint

' Open up an instance of Powerpoint and the existing template.
Set ppObj = CreateObject("PowerPoint.Application")
ppObj.Visible = True
Set ppPres = ppObj.Presentations.Open("C:/MyPowerPointTemplate.ppt")

' Open up a recordset on MyRecordSet table.
Set db = CurrentDb
Set rs = db.OpenRecordset("MyRecordSet", dbOpenDynaset)

' Setup the set of slides and populate them with data from the
' set of records.
With ppPres
While Not rs.EOF
With .Slides.Add(rs.AbsolutePosition + 1, ppLayoutText)
.SlideShowTransition.EntryEffect = ppEffectNone
.Shapes(1).TextFrame.TextRange.Text = "Any Text Here"
With .Shapes(2).TextFrame.TextRange
.Text = "MyFirstTitle: " & Chr(9) & CStr(rs.Fields("MyFirstDataElement").Value)
.Text = .Text & Chr(13) & "MySecondTitle: " & Chr(9) & CStr(rs.Fields("MySecondDataElement").Value)
.Text = .Text & Chr(13) & "MyThirdTitle: " & Chr(9) & CStr(rs.Fields("MyThirdDataElement").Value)
.Characters.Font.Color.RGB = RGB(0, 0, 0)
.Characters.Font.Shadow = False
.Characters.Font.Size = 12
.Characters.Font.Bold = True
.Characters.Font.Italic = False
.Characters.Font.Underline = False
.ParagraphFormat.Bullet.Type = ppBulletNone
End With

.Shapes(1).TextFrame.TextRange.Characters.Font.Size = 18
.Shapes(1).TextFrame.TextRange.Characters.Font.Shadow = False
.Shapes(1).TextFrame.TextRange.Characters.Font.Color.RGB = RGB(0, 0, 0)
.Shapes(1).TextFrame.TextRange.Characters.Font.Italic = False
.Shapes(1).TextFrame.TextRange.Characters.Font.Bold = True
.Shapes(1).TextFrame.TextRange.Characters.Font.Underline = False
End With

rs.MoveNext

Wend
End With

Exit Sub

err_cmdOLEPowerPoint:
MsgBox Err.Number & " " & Err.Description
End Sub