add picture doesn't wroek 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
 
V

vonclausowitz

There are no error messages, it just stops at this line:

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

vMyNextFile = "C:\Temp\001.jpg"

I changed the + into & as you suggested (no change).

Just to be clear I don't use powerpoint but Visual Basic to run my code
from.

Marco
 
V

vonclausowitz

Steve,

The only thing that works is add a picture to the slidemaster.

Set oPicture = ppPres.SlideMaster.Shapes.AddPicture("C:\Emoticon2.gif",
False, True _
, Left:=484.75, Top:=332.375, Width:=124.75,
Height:=90.75)

But that is of course not what I want...

These are all the others options I tried in vain:

'Set oPicture =
ppPres.SlideMaster.Shapes.AddPicture("C:\Emoticon2.gif", False, True _
, Left:=484.75, Top:=332.375, Width:=124.75,
Height:=90.75)

'Set oPicture = ppPres.SlideMaster.Shapes.AddOLEObject(Left:=484.75,
Top:=332.375, _
Width:=124.75, Height:=90.75, ClassName:="Forms.Image.1",
Link:=msoFalse)
'oPicture.OLEFormat.object.Picture = LoadPicture("C:\Emoticon2.gif")

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

'Call ppSlide.Shapes.AddPicture(FileName:=vMyNextFile,
LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=1, Top:=1,
Width:=1, Height:=1)
' ppApp.ActivePresentation.Slides(iMyIndex).Shapes.AddPicture
FileName:=vMyNextFile, _
LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=1,
Top:=1, Width:=1, Height:=1

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

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

' Set oPicture =
ppApp.ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:=vMyNextFile,
_
LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=1,
Top:=1, Width:=1, Height:=1)


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

Top