Consulting

Results 1 to 2 of 2

Thread: VBA to insert 3 or 4 images per slide

  1. #1
    VBAX Newbie
    Joined
    Jun 2018
    Posts
    1
    Location

    VBA to insert 3 or 4 images per slide

    Help for a VBA newbie:



    I used this VBA to add 2 images per slide to a custom slide from a local drive. Instead of 2 images per slide, I'd like it to add 3 or 4. How do I modify the code to do this?



    Sub ImportABunch()

    Dim strTemp As String
    Dim strPath As String
    Dim strFileSpec As String
    Dim oSld As Slide
    Dim oPic As Shape
    Dim x As Long

    ' Edit these to suit:
    strPath = "C:\Users\dklaz\Desktop\Prep for China\Factory Pictures\Best Beteck"
    strFileSpec = "*.jpg"

    strTemp = Dir(strPath & strFileSpec)

    Do While strTemp <> ""
    x = x + 1
    If isOdd(x) Then Set oSld = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutCustom)
    Set oPic = oSld.Shapes.AddPicture(FileName:=strPath & strTemp, _
    LinkToFile:=msoFalse, _
    SaveWithDocument:=msoTrue, _
    Left:=0, _
    Top:=0, _
    Width:=-1, _
    Height:=-1)
    'oSld.Shapes.AddPicture(strFolder & strName, msoFalse, msoTrue, -1, -1, -1, -1)
    'oPic.Width = ActivePresentation.PageSetup.SlideWidth / 2 - 50
    'oPic.Top = 150
    oSld.Shapes.Title.TextFrame.TextRange = "Add Title " & x
    'If isOdd(x) Then oPic.Left = 25 Else oPic.Left = ActivePresentation.PageSetup.SlideWidth / 2 + 25
    strTemp = Dir
    Loop

    End Sub

    Function isOdd(lngIn As Long) As Boolean
    If lngIn / 2 <> lngIn \ 2 Then
    isOdd = True
    Else
    isOdd = False
    End If
    End Function




    Thank you!!!



  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    1,697
    Location
    There is an answer on your cross post here
    https://answers.microsoft.com/en-us/...d-6a90be6746af

    If you post on several sites please indicate this. Once they find an answer poster hardly ever go back to the other places they posted meaning that helper can be working away on already solved questions.
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •