Tuesday, March 10, 2009

Export Access data into PowerPoint chart

http://support.microsoft.com/kb/200551


Set Pwr_Pnt = CreateObject("Powerpoint.application")
Pwr_Pnt.Activate
Set Presentation = Pwr_Pnt.Presentations.Open (Template_Name)
Pwr_Pnt.ActivePresentation.SaveAs PP_Filename

With Presentation
 DoCmd.OpenForm "RTS_Chart"
 Screen.ActiveForm!TheChart.Action = acOLECopy ' TheChart is the name of my chart in the form
 SlideNum = SlideNum + 1
 .Slides.Add SlideNum, ppLayoutTitleOnly
 .Slides(SlideNum).Shapes
 (1).TextFrame.TextRange.Text = "Actual vs. Projected
 Expenditures"
 .Slides(SlideNum).Shapes.Paste
end with

Here's how to add a slide with bulleted text:
With Presentation
SlideNum = SlideNum + 1
.Slides.Add SlideNum, ppLayoutTitle
.Slides(SlideNum).Shapes
(1).TextFrame.TextRange.Text = "Internal Issues"
.Slides(SlideNum).Shapes(1).Top = 0
.Slides(SlideNum).Shapes(1).Left = 100
.Slides(SlideNum).Shapes.AddTextbox
msoTextOrientationHorizontal, 100, 100, 200, 150
.Slides(SlideNum).Shapes
(2).TextFrame.TextRange.Text = "None"
.Slides(SlideNum).Shapes(2).Top = 100
.Slides(SlideNum).Shapes(2).Left = 20
.Slides(SlideNum).Shapes
(2).TextFrame.TextRange.ParagraphFormat.Bullet.Type =
ppBulletUnnumbered
.Slides(SlideNum).Shapes
(2).TextFrame.TextRange.ParagraphFormat.Alignment =
ppAlignLeft
end with

If you select the MIcrosoft Powerpoint 9.0 Object Library
as one of your references in VB, then you can go into the
object browser (View->Object Browser) and look at all the
classes and properties that are available to you.
I found a lot of information in the microsoft
knowledgebase articles 200551 and 209960

'##########################################################

Option Compare Database
Option Explicit
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 a recordset on the Project List table.
Set db = CurrentDb
Set rs = db.OpenRecordset("Project List", dbOpenDynaset)


' Open up Powerpoint.
Set ppObj = New PowerPoint.Application
Set ppPres = ppObj.Presentations.Add
' 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, ppLayoutTitle)
.Shapes(1).TextFrame.TextRange.Text =
CStr(rs.Fields("Topic_Owner
(my:myFields/my:CBT_Topic_Owner)").Value)
.Shapes(2).TextFrame.TextRange.Text =
CStr(rs.Fields("Project_Name").Value)
End With
rs.MoveNext
Wend
End With
Exit Sub
err_cmdOLEPowerPoint:
MsgBox Err.Number & " " & Err.Description
End Sub



'#############################################
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 a recordset on the Employees table.
    Set db = CurrentDb
    Set rs = db.OpenRecordset("Employees", dbOpenDynaset)
   
    ' Open up an instance of Powerpoint.
    Set ppObj = New PowerPoint.Application
    Set ppPres = ppObj.Presentations.Add
   
    ' 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, ppLayoutTitle)
                .Shapes(1).TextFrame.TextRange.Text = "Hi!  Page " & rs.AbsolutePosition + 1
                .SlideShowTransition.EntryEffect = ppEffectFade
                With .Shapes(2).TextFrame.TextRange
                    .Text = CStr(rs.Fields("LastName").Value)
                    .Characters.Font.Color.RGB = RGB(255, 0, 255)
                    .Characters.Font.Shadow = True
                End With
                .Shapes(1).TextFrame.TextRange.Characters.Font.Size = 50
            End With
            rs.MoveNext
        Wend
    End With
   
    ' Run the show.
    ppPres.SlideShowSettings.Run
   
    Exit Sub
   
err_cmdOLEPowerPoint:
    MsgBox Err.Number & " " & Err.Description
End Sub

No comments:

Post a Comment