B
BigAnthony
The following code below works with a Reference set to PowerPoint. Could
someone help me convert the folowing code to late binding? My attempt is
below the original code.
ORIGINAL CODE***************
Dim db As Database, rs As Recordset
Dim ppObj As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
'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 employee
table.
With PPPres
While Not rs.EOF
With .Slides.Add(rs.AbsolutePosition + 1, ppLayoutText)
.Shapes(1).TextFrame.TextRange.Text = CStr
(rs.Fields"EmployeeCode").value)
With .Shapes(2).TextFrame.TextRange
.Text = "First = " & CStr(rs.Fields("EmployeeFirst").value)
& vbCrLf & _
"Last = " & CStr(rs.Fields("EmployeeLast").
value) & vbCrLf & _
"Hours = " & CStr(rs.Fields("EmployeeHours").
value) & vbCrLf & _
"Position = " & CStr(rs.Fields("EmployeePosition").
value) & vbCrLf & _
"Rate = " & CStr(rs.Fields("EmployeeRate").
value)
.Characters.Font.Color.RGB = RGB(0, 0, 255)
.Characters.Font.Shadow = True
.Characters.Font.Size = 26
End With
.Shapes(1).TextFrame.TextRange.Characters.Font.Size = 30
End With
rs.MoveNext
Wend
End With
'run the show.
PPPres.SlideShowSettings.Run
********************************
This is my attempt. When I run it in the immediate window, I get an error
message saying "Object doesn't support this property or method." (Error 438)
MY ATTEMPT ****************
Dim PPApp As Object
Dim PPPres As Object
Dim PPSlide As Object
Dim db As Database, rs As Recordset
'Open up a recordset on the Employees table.
Set db = CurrentDb
Set rs = db.OpenRecordset("Employees", dbOpenDynaset)
Set PPApp = CreateObject("Powerpoint.Application")
Set PPPres = PPApp.Presentations.Add
With PPPres
While Not rs.EOF
With PPPres.Slides
Set PPSlide = .Add(rs.AbsolutePosition + 1, 2)
.Shapes(1).TextFrame.TextRange.Text = CStr(rs.Fields
("EmployeeCode").value)
With PPSlide
.Text = "First = " & CStr(rs.Fields("EmployeeFirst").value)
& vbCrLf & _
"Last = " & CStr(rs.Fields("EmployeeLast").
value) & vbCrLf & _
"Hours = " & CStr(rs.Fields("EmployeeHours").
value) & vbCrLf & _
"Position = " & CStr(rs.Fields("EmployeePosition").
value) & vbCrLf & _
"Rate = " & CStr(rs.Fields("EmployeeRate").
value)
.Characters.Font.Color.RGB = RGB(0, 0, 255)
.Characters.Font.Shadow = True
.Characters.Font.Size = 26
End With
.Shapes(1).TextFrame.TextRange.Characters.Font.Size = 30
End With
rs.MoveNext
Wend
End With
'run the show.
PPPres.SlideShowSettings.Run
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
I would appreciate any help.
Thanks
Anthony
someone help me convert the folowing code to late binding? My attempt is
below the original code.
ORIGINAL CODE***************
Dim db As Database, rs As Recordset
Dim ppObj As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
'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 employee
table.
With PPPres
While Not rs.EOF
With .Slides.Add(rs.AbsolutePosition + 1, ppLayoutText)
.Shapes(1).TextFrame.TextRange.Text = CStr
(rs.Fields"EmployeeCode").value)
With .Shapes(2).TextFrame.TextRange
.Text = "First = " & CStr(rs.Fields("EmployeeFirst").value)
& vbCrLf & _
"Last = " & CStr(rs.Fields("EmployeeLast").
value) & vbCrLf & _
"Hours = " & CStr(rs.Fields("EmployeeHours").
value) & vbCrLf & _
"Position = " & CStr(rs.Fields("EmployeePosition").
value) & vbCrLf & _
"Rate = " & CStr(rs.Fields("EmployeeRate").
value)
.Characters.Font.Color.RGB = RGB(0, 0, 255)
.Characters.Font.Shadow = True
.Characters.Font.Size = 26
End With
.Shapes(1).TextFrame.TextRange.Characters.Font.Size = 30
End With
rs.MoveNext
Wend
End With
'run the show.
PPPres.SlideShowSettings.Run
********************************
This is my attempt. When I run it in the immediate window, I get an error
message saying "Object doesn't support this property or method." (Error 438)
MY ATTEMPT ****************
Dim PPApp As Object
Dim PPPres As Object
Dim PPSlide As Object
Dim db As Database, rs As Recordset
'Open up a recordset on the Employees table.
Set db = CurrentDb
Set rs = db.OpenRecordset("Employees", dbOpenDynaset)
Set PPApp = CreateObject("Powerpoint.Application")
Set PPPres = PPApp.Presentations.Add
With PPPres
While Not rs.EOF
With PPPres.Slides
Set PPSlide = .Add(rs.AbsolutePosition + 1, 2)
.Shapes(1).TextFrame.TextRange.Text = CStr(rs.Fields
("EmployeeCode").value)
With PPSlide
.Text = "First = " & CStr(rs.Fields("EmployeeFirst").value)
& vbCrLf & _
"Last = " & CStr(rs.Fields("EmployeeLast").
value) & vbCrLf & _
"Hours = " & CStr(rs.Fields("EmployeeHours").
value) & vbCrLf & _
"Position = " & CStr(rs.Fields("EmployeePosition").
value) & vbCrLf & _
"Rate = " & CStr(rs.Fields("EmployeeRate").
value)
.Characters.Font.Color.RGB = RGB(0, 0, 255)
.Characters.Font.Shadow = True
.Characters.Font.Size = 26
End With
.Shapes(1).TextFrame.TextRange.Characters.Font.Size = 30
End With
rs.MoveNext
Wend
End With
'run the show.
PPPres.SlideShowSettings.Run
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
I would appreciate any help.
Thanks
Anthony