1. is it possible to add pictures programmatically to Clip Art Organ
Dear All I'm wondering is it possible to add pictures programmatically to Clip Art Organizer? thanks in advance.
2. is it possible to add pictures to Clip Art Organizer programmatica
3. best method to add pictures
What the best method to add pictures in Power Point to get good on-screen viewing and quality printing of slide shows.
4. Batch add pictures to Power Point
5. how do I add pictures one at a time to a slide
I have inserted pictures and done the individual custom animation - how do I get the slide to start blank and add one picture at a time.
6. Adding pictures to a slide?
7. add picture doesn't wroek from VB
In article < XXXX@XXXXX.COM >, wrote:
> 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.
Are there error messages?
What happens if you add a break point there and manually step through the code?
What's the output if you do
Debug.Print vMyNextFile
just prior to that point?
Suggestion: don't use + for string concatenation. Use & instead.
Ex:
vMyFile = Dir(vNewPath & "*." & vFileExt)
rather than
vMyFile = Dir(vNewPath + "*." + vFileExt)
>
> 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
>
-----------------------------------------
Steve Rindsberg, PPT MVP
PPT FAQ: www.pptfaq.com
PPTools: www.pptools.com
================================================