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