Consulting

Results 1 to 7 of 7

Thread: Insert images, from 3 different folders, into to specific locations of same document

  1. #1
    VBAX Regular
    Joined
    Apr 2017
    Posts
    6
    Location

    Post Insert images, from 3 different folders, into to specific locations of same document

    batchInsertABC.jpg

    Hi Guys, I am new to VBA and i am trying to:

    Write a macro to do a photo report on ms word.

    I wish to batch insert photos into location A,B and C from the folders A,B and C respectively.
    The macro should be able to:

    - Add the first picture in folder A to Area A in page 1, then add the second picture in folder A to Area A in page 2....till the last picture in folder A has been added.
    - Repeat this process for adding first picture in folder B to Area B in Page 1...
    - Repeat this process for C
    - Add a caption line under each picture
    - If any picture is deleted, for example, page 2B is deleted, page 3B moves up to fill up the black space for 2B.
    - The size of B and C is same. A is smaller (refer to attached image)

    This is a rather complicated process for me. So far, through the help of other questions in this forum, i am able to insert pictures via macro from 1 folder only. I am also able to add captions. But i am unable to access more than 1 folder. I am trying to add over 200 pages at a time per document.

    Do i need to use bookmarks?

    Any help would be appreciated.

    Tahmz

  2. #2
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    Where is the code you have managed so far?
    Greg

    Visit my website: http://gregmaxey.com

  3. #3
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Do all the required pages & tables (assuming that's what your 'areas' are) already exist, or is the code supposed to add them as it goes? Does each table (again, assuming that's what your 'areas' are) have two rows - one for the picture and one for the caption? Assuming the answers to both questions are yes, the following macro could be used:
    Sub AddPicsFromFolders()
    Application.ScreenUpdating = False
    Dim ArrFldr(), ArrHght(), oTbl As Table, i As Long, j As Long
    Dim strFolder As String, strFile As String
    ArrFldr() = Array("Folder1", "Folder2", "Folder3")
    ArrHght() = Array(2, 3, 3)
    CaptionLabels.Add Name:="Picture"
    For i = 0 To UBound(ArrFldr())
      strFolder = "C:\Users\" & Environ("Username") & "\Pictures\" & ArrFldr(i) & "\"
      strFile = Dir(strFolder & "*.jpg", vbNormal)
      j = 0
      While strFile <> ""
        j = j + 1
        Set oTbl = ActiveDocument.Tables(j * (UBound(ArrFldr()) + 1) - UBound(ArrFldr()) + i)
        With oTbl
          .AllowAutoFit = False
          'Format the rows
          Call FormatRows(oTbl, CSng(ArrHght(i)))
          'Insert & size the Picture
          .Range.InlineShapes.AddPicture FileName:=strFolder & strFile, LinkToFile:=False, _
            SaveWithDocument:=True, Range:=.Cell(1, 1).Range
          With .Range.InlineShapes(1)
            .LockAspectRatio = True
            .Height = InchesToPoints(CSng(ArrHght(i)))
          End With
          'Insert the Caption on the row below the picture
          With .Cell(.Rows.Count, 1).Range
            .InsertBefore vbCr
            .Characters.First.InsertCaption Label:="Picture", _
              Title:=Split(strFile, ".")(0), _
              Position:=wdCaptionPositionBelow, ExcludeLabel:=False
            .Characters.First = vbNullString
            .Characters.Last.Previous = vbNullString
          End With
        End With
        If j Mod 10 = 0 Then DoEvents
        strFile = Dir()
      Wend
    Next
    Application.ScreenUpdating = True
    End Sub
    '
    Sub FormatRows(oTbl As Table, Hght As Single)
      With oTbl
        With .Rows(1)
          .Height = InchesToPoints(Hght)
          .HeightRule = wdRowHeightExactly
          .Range.Style = "Normal"
        End With
        With .Rows(2)
          .Height = InchesToPoints(0.25)
          .HeightRule = wdRowHeightExactly
          .Range.Style = "Caption"
        End With
      End With
    End Sub
    As coded, the macro :
    • assumes the pictures to be inserted are in folders named Folder1, Folder2, & Folder3, respectively, in your Pictures folder. Change the filepaths to suit.
    • doesn't require you to have the table row-height pre-set; it does that for itself using the heights (in inches) specified in 'ArrHght() = Array(2, 3, 3)', which presently applies 2, 3, & 3 inch heights, respectively.
    • uses the "Normal" and "Caption" Styles for the image and caption rows, respectively. These both left-align the content, but you can change that and/or which Styles get used. Whichever Style you use for the image row, it should have 0 space before & after; otherwise the image won't fit properly.
    If you'd rather the macro did no table formatting, you could comment-out 'Call FormatRows(oTbl, CSng(ArrHght(i)))'
    Last edited by macropod; 04-12-2017 at 06:41 AM.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  4. #4
    VBAX Regular
    Joined
    Apr 2017
    Posts
    6
    Location
    Hi Greg
    Hi Paul

    Thank you for the very quick response. I have tried the code that you have provided. When i run the code, nothing happens. But at the same time, there are no errors.
    I have changed the file path like you mentioned but it did not run. Were you able to run this on your system?

    For the most part, i understand what you are trying to do using arrays.


    This is what i compiled previously in order to add pictures from a folder(found this somewhere online):

    Sub InsertImage()




    Dim fd As FileDialog
    Dim oTable As Table
    Dim iRow As Integer
    Dim iCol As Integer
    Dim oCell As Range
    Dim i As Long
    Dim sNoDoc As String
    Dim picName As String
    Dim scaleFactor As Long
    Dim max_height As Single
    'define resize constraints
    max_height = 275


    'add a 1 row 2 column table to take the images
    Set oTable = Selection.Tables.Add(Selection.Range, 1, 1)
    '+++++++++++++++++++++++++++++++++++++++++++++
    'oTable.AutoFitBehavior (wdAutoFitFixed)
    oTable.Rows.Height = CentimetersToPoints(4)
    oTable.Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter
    '++++++++++++++++++++++++++++++++++++++++++++++


    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
    .Title = "Select image files and click OK"
    .Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png; *.wmf"
    .FilterIndex = 2
    If .Show = -1 Then


    For i = 1 To .SelectedItems.Count


    iCol = 1
    iRow = i
    'get filename
    picName = Right(.SelectedItems(i), Len(.SelectedItems(i)) - InStrRev(.SelectedItems(i), "\"))
    'remove extension from filename ****
    picName = Left(picName, InStrRev(picName, ".") - 1)


    'select cell
    Set oCell = ActiveDocument.Tables(1).Cell(iRow, iCol).Range


    'insert image
    oCell.InlineShapes.AddPicture FileName:= _
    .SelectedItems(i), LinkToFile:=False, _
    SaveWithDocument:=True, Range:=oCell


    'resize image
    If oCell.InlineShapes(1).Height > max_height Then
    scale_factor = oCell.InlineShapes(1).ScaleHeight * (max_height / oCell.InlineShapes(1).Height)
    oCell.InlineShapes(1).ScaleHeight = scale_factor
    oCell.InlineShapes(1).ScaleWidth = scale_factor
    End If


    'center content
    oCell.ParagraphFormat.Alignment = wdAlignParagraphCenter


    'insert caption below image
    oCell.InlineShapes(1).Range.InsertCaption Label:="Figure", TitleAutoText:="", _
    Title:=": " & picName
    If i < .SelectedItems.Count And i Mod 2 = 0 Then 'add another row, more to go
    oTable.Rows.Add
    End If
    Next i
    End If
    End With


    Set fd = Nothing
    End Sub

  5. #5
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Quote Originally Posted by Tahmz View Post
    I have tried the code that you have provided. When i run the code, nothing happens. But at the same time, there are no errors.
    I have changed the file path like you mentioned but it did not run.
    That's most likely because your document doesn't satisfy the conditions stipulated in my post about the macro - three tables per page; one for each image.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  6. #6
    VBAX Regular
    Joined
    Apr 2017
    Posts
    6
    Location
    Hi Paul

    Thanks for the reply. I added in the 3 tables ( with 2 rows each, 1 for pic 1 for caption). But still i do not see anything happening. tables.jpg

    My original intention was not to use tables though using tables is fine as well. But i do not see any errors when i run the code either. Any idea what could be wrong?

  7. #7
    VBAX Regular
    Joined
    Apr 2017
    Posts
    6
    Location
    Okay i managed to get something. I realized that the file path had an issue. Thanks so much paul

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
  •