Convert PowerPoint Reference to late Binding

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
 
C

Carmen Ferrara

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

Your method of setting up and instantiating the PowerPoint objects for
late-binding looks correct. Which line is the error occurring on?
Also, I'd try simplifying the routine and get the late-binding bit
working first. Then incrementally add the data access stuff.

Let me know which line is causing the issue and I'll see if I can help
further.

Carmen-
 
B

BigAnthony

Carmen,

It seems to be failing on this line:

..Shapes(1).TextFrame.TextRange.Text = CStr(rs.Fields"EmployeeCode").value)

I get the "Object doesn't support this property or method" error method.
(Error 438)

Thanks for helping,
Anthony
 
S

Shyam Pillai

Try changing this line:
..Shapes(1).TextFrame.TextRange.Text = CStr(rs.Fields"EmployeeCode").value)

to

..Shapes(1).TextFrame.TextRange.Text = CStr(rs.Fields("EmployeeCode").value)


Regards,
Shyam Pillai

Handout Wizard
http://skp.mvps.org/how
 
B

BigAnthony

Those lines are the same. When I put in the double period at the start I get
a syntax error.
 
C

Carmen Ferrara

Those lines are the same. When I put in the double period at the start I get
a syntax error.


I believe the Shapes object is collection on a particular Slide object
(as opposed to the entire Slides collection).

So, I think you need to reference a particular slide.

Try changing this line:

With PPPres.Slides

to:
With PPPres.Slides(x)

where (x) is the index of a particular slide (1 based index I
believe).

Let me know how that goes.

Carmen-
 
B

BigAnthony

Carmen,

I put in the change you requested:With PPPres.Slides(x)

I dimmed X as integer, but when I run it in the immediate window I get the
following error message:

"Slides.Item: Integer out of range. 0 is not in Index's valid range of 1 to
0. Error number is -2147188160"

Anthony
 
C

Carmen Ferrara

Carmen,

I put in the change you requested:With PPPres.Slides(x)

I dimmed X as integer, but when I run it in the immediate window I get the
following error message:

"Slides.Item: Integer out of range. 0 is not in Index's valid range of 1 to
0. Error number is -2147188160"

Anthony

I believe the index to that collection is 1 based - so initialize X =
1. Also, I assume you are running this as part of a for loop so you
can just add something like:
---------------
Dim x as Integer
For x = 1 to PPPres.Slide.Count

With PPPres.Slides(x)

Set PPSlide = .Add(rs.AbsolutePosition + 1, 2)

.Shapes(1).TextFrame.TextRange.Text =
CStr(rs.Fields("EmployeeCode").value)
 
B

BigAnthony

Carmen,

I still get the same error, with those additions you gave me.

"Object does not support this property or method. Error No. 438."

I think I'll just forget about it - I have the code working with Early
binding, I was just hoping I could convert it to late binding.

Thanks for your help
Anthony
 
C

Carmen Ferrara

Carmen,

I still get the same error, with those additions you gave me.

"Object does not support this property or method. Error No. 438."

I think I'll just forget about it - I have the code working with Early
binding, I was just hoping I could convert it to late binding.

Thanks for your help
Anthony

Sorry it's not working out. There are some advantages to late-binding
(trade-offs too), so if it's a critical requirement, I can help out
further. If you'd like, email me directly and I'll see if I take a
look at the actual PPT / VB sub itself.

Regards,
Carmen-
 
B

BigAnthony

Steve,

You are are correct!

I actually do have "CStr(rs.Fields("EmployeeCode").value)" in my code - I
must have left a parenthesis out.

(Sorry about late reply, have been ill)

Anthony
 
B

BigAnthony

Hi,

I have it working. Just needed some time away from it and another go at it!

Below is the code I can use without setting a PowerPoint reference.

Thanks for the assistance.

Regards,
Amthony

Dim PPApp As Object 'late binding
Dim PPPres As Object
Dim PPSlide As Object
Dim db As Database, rs As Recordset
Dim strSql As String

Set PPApp = GetObject(, "PowerPoint.Application")

If PPApp Is Nothing Then 'no existing application is running
Set PPApp = CreateObject("PowerPoint.Application")
End If

If PPApp Is Nothing Then 'not able to create the application
MsgBox "The application is not available!", vbExclamation
End If

'Open up a recordset on the employee table.
Set db = CurrentDb
strSql = "SELECT * From [Employee] WHERE (Status = True);"

Set rs = db.OpenRecordset(strSql)

Set PPPres = PPApp.Presentations.Add

With PPApp

While Not rs.EOF

With PPPres.Slides

Set PPSlide = .Add(rs.AbsolutePosition + 1, 2)

PPSlide.Shapes(1).TextFrame.TextRange.Text =
UCase(CStr(rs.Fields("EmployeeID").value))

PPSlide.Shapes(2).TextFrame.TextRange.Text = "Name =
" & CStr(rs.Fields("FirstName").value) & vbCrLf & _
"Surname = " & CStr(rs.Fields("Surname").value)&
vbCrLf & _
"Phone = " & CStr(rs.Fields("Phone").value) & vbCrLf
& _
"Level = " & CStr(rs.Fields("Level").value)


PPSlide.Shapes(1).TextFrame.TextRange.Characters.Font.Size = 30

PPSlide.Shapes(2).TextFrame.TextRange.Characters.Font.Size = 26

PPSlide.Shapes(2).TextFrame.TextRange.Characters.Font.Color = vbBlue

End With

rs.MoveNext

Wend

End With

PPPres.SlideShowSettings.Run

Set PPApp = Nothing
Set PPSlide = Nothing
Set PPPres = Nothing

End If

End If
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top