Using VBA Access 2007 to manipulate PowerPoint 2007 1

[aldi07]

Hi, I am trying to copy some photos from a folder, into a new PowerPoint presentation 2007, using Access 2007 VBA.
I have two problems:

1- I must open manually a new PowerPoint presentation, before running the Access VBA, otherwise I get the error message:

“-2147188160 Shape (unknown member):Invalid request. To select a shape, its view must be active”

2- When I open a new PowerPoint manually, then I run the Access VBA, It copies the first picture into the first slide, then the second picture into the second slide, then I get the SAME error message as mentioned above.

BUT:
If I run the Access VBA step by step, and I manually select the next slide after the statement:

With .Slides.Add(rs.AbsolutePosition + 1, ppLayoutTitle)

it works fine, without any error.

Here is the entire code:


Sub cmdPowerPoint_Click()
Dim db As Database
Dim rs As Recordset
Dim ppObj As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim FilePathAndName As String
Dim I As Integer

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.
I = 1
With ppPres
While Not rs.EOF
FilePathAndName = "C:\Photos\PhotosAll\Slide" & Trim(Str(I)) & ".jpg"
With .Slides.Add(rs.AbsolutePosition + 1, ppLayoutTitle)
.Shapes.AddPicture( _
FileName:=FilePathAndName, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, Left:=0, Top:=0, _
Width:=720, Height:=540).Select
.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
I = I + 1
End With
rs.MoveNext
Wend
End With
' Run the show.
ppPres.SlideShowSettings.Run

Exit Sub

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


So I have two questions:

1- What statement should I add, to avoid having to open a new PowerPoint document manually?

2- What statement should I add so that the selection goes automatically to the next slide, after the statement:

With .Slides.Add(rs.AbsolutePosition + 1, ppLayoutTitle)

Thank you in advance.

 

[aldi07]

OK, I found my mistakes for whoever could be interested. The modifications are indicated in red:

Sub cmdPowerPoint_Click()
Dim db As Database
Dim rs As Recordset
Dim ppObj As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim FilePathAndName As String
Dim I As Integer

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.
I = 1
With ppPres
While Not rs.EOF
FilePathAndName = "C:\Photos\PhotosAll\Slide" & Trim(Str(I)) & ".jpg"
With .Slides.Add(rs.AbsolutePosition + 1, ppLayoutTitle)
With .Shapes.AddPicture( _
FileName:=FilePathAndName, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, Left:=0, Top:=0, _
Width:=720, Height:=540).Select
End With
.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
I = I + 1
End With
rs.MoveNext
Wend
.SaveAs "C:\Photos\PhotosAll\AllMyPhotos", ppSaveAsPresentation
End With
' Run the show.
ppPres.SlideShowSettings.Run

Exit Sub

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

 

[kjv1611]

Glad you got it sorted out, and thanks for sharing your corrections. For future reference, I highly suggest proper code spacing (tabbing over clause sections) for easier reading. It'll help others help you, and if you're helping someone else, it'll be FAR easier to read through and understand.

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57

 

[aldi07]

kjv1611, thank you for your answer. You are quite right.
My code was indented, but when I pasted it here, it removed all the indentation.
I tried using the indent provided in the above menu, but when I looked at the preview, for some reason, it was not applied.
What am I doing wrong?

 

[kjv1611]

The best practice at Tek-Tips for posting any code is to use the [IGNORE]

[/IGNORE] Tags. When you're working on a new post, if you click the question mark to the left of the "Preview" button, you'll get a pop-up that'll guide you through all or most of the tgml tags in use so far.

Another note is this: In the VBE (VB Editor) window, you'll likely have your code spaced out with the tab character. Well, if you leave that here, sometimes even with the Code tags, it'll still remove the tabbing. So I do sometimes have to manually space over text with the spacebar (5 spaces per tab).

Example using Code tags:

Sub ShowMeAMessage()
    Dim strMsg As String
    strMsg = "Howdy Doody, y'all!"
    MsgBox strMsg, vbInformation, "Yee Haw"
End Sub

In this example, it did keep the tab characters. It may be when I've used other tags for some reason, perhaps a quote tag, where tgml dropped the tab characters.

Hopefully that helps a little.

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57

 

[aldi07]

Thank you for the tip !