add picture doesn't work from VB

V

vonclausowitz

Hi ALL,

I have a VB application from which I access powerpoint.
I create a new presentation, add 1 slide and input all pictures from a
given folder.
Add the point where I have to add the pictures the code stops.

Here's my code:

Private Sub PPT_Insert_Graphics()

Static ppApp As PowerPoint.Application
Static ppPres As PowerPoint.Presentation
Static ppSlide As PowerPoint.Slide
Const ppLayoutTitleOnly = 11
Dim nSlideWidth As Single
Dim nSlideHeight As Single
Dim iMyIndex As Integer
Dim iTotalInserts As Integer
Dim oPicture As Object
Dim vMessage, vTitle, vDefaultPath, vNewPath, vMyPath, vMyFile,
vMyNextFile
Dim vFileExt, vDefaultExt

If ppApp Is Nothing Then
' Start PowerPoint with a new presentation
Set ppApp = CreateObject("powerpoint.application")
ppApp.Visible = True
Set ppPres = ppApp.Presentations.Add

nSlideWidth = ppPres.PageSetup.SlideWidth
nSlideHeight = ppPres.PageSetup.SlideHeight

' Initialize counters
iMyIndex = 1 ' where to start inserting the slides
iTotalInserts = 0 'How many files inserted (gewhiz thing)

vNewPath = BrowseFolder("Waar staan de afbeeldingen?")
vNewPath = vNewPath & "\"

If vNewPath = "" Then End ' A way out if you change your mind
vMessage = "Extensie voor de afbeeldingen (* voor alle)."
vDefaultExt = "*"
vFileExt = InputBox(vMessage, vTitle, vDefaultExt)
vMyFile = Dir(vNewPath + "*." + vFileExt)
Do While vMyFile <> "" ' Start the Loop
vMyNextFile = vNewPath + vMyFile

ppPres.Slides.Add Index:=iMyIndex, Layout:=ppLayoutBlank

---> here things stop!!!!!!!!!!!!!!!!!!!!!!!!

Set oPicture = ppSlide.Shapes.AddPicture(FileName:=vMyNextFile, _
LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=1,
Top:=1, Width:=1, Height:=1)

' Now scale the picture to full size, with "Relative to original
' picture size" set to true for both height and width.
oPicture.ScaleHeight 1, msoTrue
oPicture.ScaleWidth 1, msoTrue
oPicture.LockAspectRatio = msoTrue

' Move the picture to the center of the slide. Select it.
With ppPres.PageSetup
If oPicture.Height > oPicture.Width Then
oPicture.Height = nSlideHeight
Else
oPicture.Width = nSlideWidth
End If
oPicture.Left = (nSlideWidth \ 2) - (oPicture.Width \ 2)
oPicture.Top = (nSlideHeight \ 2) - (oPicture.Height \ 2)
oPicture.Select
End With

iMyIndex = iMyIndex + 1 'add one to the slide index
vMyFile = Dir() ' Get next entry
iTotalInserts = iTotalInserts + 1 ' add one to the nuber of files
inserted.
Loop
'ActiveWindow.View.GotoSlide Index:=1 'return to the first graphic
inserted.

'Set up message box.
If iMyIndex = 1 Then
MsgBox iTotalInserts & " Afbeelding ingevoegd", _
vbInformation, " Afbeeldingen Invoegen"
Else
MsgBox iTotalInserts & " Afbeeldingen ingevoegd", _
vbInformation, " Afbeeldingen Invoegen"
End If

ppApp.ActiveWindow.Selection.Unselect
Else
ppApp.Quit
Set ppChart = Nothing
Set ppSlide = Nothing
Set ppPres = Nothing
Set ppApp = Nothing
End If

End Sub


Regards

MArco
The Netherlands
 
T

titatino

beste co...soms moet je wat anders gaan doen en er niet te lang over
denken...
de oplossing komt vanzelf...
confucius from leiden.....@#$%
 
V

vonclausowitz

Hi Titanus,

Please answer in a proper language instead of this cloggie style.

Regards
von Clausowitz
 
M

Mike M.

See inline comments.

Hi ALL,

I have a VB application from which I access powerpoint.
I create a new presentation, add 1 slide and input all pictures from a
given folder.
Add the point where I have to add the pictures the code stops.

Here's my code:

Private Sub PPT_Insert_Graphics()

Static ppApp As PowerPoint.Application
Static ppPres As PowerPoint.Presentation
Static ppSlide As PowerPoint.Slide
Const ppLayoutTitleOnly = 11
Dim nSlideWidth As Single
Dim nSlideHeight As Single
Dim iMyIndex As Integer
Dim iTotalInserts As Integer
Dim oPicture As Object
Dim vMessage, vTitle, vDefaultPath, vNewPath, vMyPath, vMyFile,
vMyNextFile
Dim vFileExt, vDefaultExt

If ppApp Is Nothing Then
' Start PowerPoint with a new presentation
Set ppApp = CreateObject("powerpoint.application")
ppApp.Visible = True
Set ppPres = ppApp.Presentations.Add

nSlideWidth = ppPres.PageSetup.SlideWidth
nSlideHeight = ppPres.PageSetup.SlideHeight

' Initialize counters
iMyIndex = 1 ' where to start inserting the slides
iTotalInserts = 0 'How many files inserted (gewhiz thing)

vNewPath = BrowseFolder("Waar staan de afbeeldingen?")
vNewPath = vNewPath & "\"

If vNewPath = "" Then End ' A way out if you change your mind
vMessage = "Extensie voor de afbeeldingen (* voor alle)."
vDefaultExt = "*"
vFileExt = InputBox(vMessage, vTitle, vDefaultExt)
vMyFile = Dir(vNewPath + "*." + vFileExt)
Do While vMyFile <> "" ' Start the Loop
vMyNextFile = vNewPath + vMyFile

ppPres.Slides.Add Index:=iMyIndex, Layout:=ppLayoutBlank

---> here things stop!!!!!!!!!!!!!!!!!!!!!!!!
Click to expand...

***** At this point you haven't set ppSlide to anything yet. This won't
work. *********
 
V

vonclausowitz

Thanks Mike,

You pointed me in the right direction. I got it working now:

Private Sub PPT_Insert_Graphics()

Static ppApp As PowerPoint.Application 'Object
Static ppPres As PowerPoint.Presentation 'Object
Static ppSlide As PowerPoint.Slide 'Object
Const ppLayoutTitleOnly = 11
Dim nSlideWidth As Single
Dim nSlideHeight As Single
Dim iMyIndex As Integer
Dim iTotalInserts As Integer
Dim oPicture As PowerPoint.Shape 'Object
Dim vMessage, vTitle, vDefaultPath, vNewPath, vMyPath, vMyFile,
vMyNextFile
Dim vFileExt, vDefaultExt

vNewPath = BrowseFolder("Waar staan de afbeeldingen?")
If Right(vNewPath, 1) <> "\" Then
vNewPath = vNewPath & "\"
Else
vNewPath = vNewPath
End If

If vNewPath = "" Then End ' A way out if you change your mind
vMessage = "Extensie voor de afbeeldingen (* voor alle)."
vDefaultExt = "*"
vFileExt = InputBox(vMessage, vTitle, vDefaultExt)
vMyFile = Dir(vNewPath & "*." & vFileExt)

If ppApp Is Nothing Then
' Start PowerPoint with a new presentation
Set ppApp = CreateObject("powerpoint.application")
ppApp.Visible = True
Set ppPres = ppApp.Presentations.Add

nSlideWidth = ppPres.PageSetup.SlideWidth
nSlideHeight = ppPres.PageSetup.SlideHeight

' Initialize counters
iMyIndex = 1 ' where to start inserting the slides
iTotalInserts = 0 'How many files inserted (gewhiz thing)

Do While vMyFile <> "" ' Start the Loop
vMyNextFile = vNewPath + vMyFile

Set ppSlide = ppPres.Slides.Add(Index:=iMyIndex,
Layout:=ppLayoutBlank)
ppApp.ActiveWindow.View.GotoSlide Index:=iMyIndex

Set oPicture = ppSlide.Shapes.AddPicture(FileName:=vMyNextFile, _
LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=1,
Top:=1, Width:=1, Height:=1)

' Now scale the picture to full size, with "Relative to original
' picture size" set to true for both height and width.
oPicture.ScaleHeight 1, msoTrue
oPicture.ScaleWidth 1, msoTrue
oPicture.LockAspectRatio = msoTrue

' Move the picture to the center of the slide. Select it.
With ppPres.PageSetup
If oPicture.Height > oPicture.Width Then
oPicture.Height = nSlideHeight
Else
oPicture.Width = nSlideWidth
End If
oPicture.Left = (nSlideWidth \ 2) - (oPicture.Width \ 2)
oPicture.Top = (nSlideHeight \ 2) - (oPicture.Height \ 2)
oPicture.Select
End With

iMyIndex = iMyIndex + 1 'add one to the slide index
vMyFile = Dir() ' Get next entry
iTotalInserts = iTotalInserts + 1 ' add one to the nuber of files
inserted.
Loop
ppApp.ActiveWindow.View.GotoSlide Index:=1 'return to the first
graphic inserted.

'Set up message box.
If iMyIndex = 1 Then
MsgBox iTotalInserts & " Afbeelding ingevoegd", _
vbInformation, " Afbeeldingen Invoegen"
Else
MsgBox iTotalInserts & " Afbeeldingen ingevoegd", _
vbInformation, " Afbeeldingen Invoegen"
End If

ppApp.ActiveWindow.Selection.Unselect
Else

ppApp.Quit
Set oPicture = Nothing
Set ppSlide = Nothing
Set ppPres = Nothing
Set ppApp = Nothing
End If

End Sub

Regards
Marco
 

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

Similar Threads

add picture doesn't wroek from VB 6
Charts from EXCEL into PPT with .POT 1
How to export from Excel to PowerPoint 7
Can I paste a chart from Excel into a powerpoint slide "Placeholde 1
opening up Powerpoint slide from Excel 2
Excel CopyPicture and PowerPoint 7
Chart to PPT from linked sheets 3
Export from Excel to Powerpoint 2

Top