Results 1 to 20 of 53

Thread: Insert Multiple Pictures Into Table Word With Macro

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #3
    VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,273
    Location
    I believe the OP wants to be able to select multiple pictures and insert them into a table, with pictures on the odd rows and their captions on the even rows. To that end, try:
    Sub AddPics() 
        Application.ScreenUpdating = False
        Dim oTbl As Table, i As Long, j As Long, k As Long, StrTxt As String
        'Select and insert the Pics
        With Application.FileDialog(msoFileDialogFilePicker)
            .Title = "Select image files and click OK"
            .Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png"
            .FilterIndex = 2
            If .Show = -1 Then
                'Add a 2-row by 2-column table with 7cm columns to take the images
                Set oTbl = Selection.Tables.Add(Selection.Range, 2, 2)
                With oTbl
                    .AutoFitBehavior (wdAutoFitFixed)
                    .Columns.Width = CentimetersToPoints(7)
                    'Format the rows
                    Call FormatRows(oTbl, 1)
                End With
                CaptionLabels.Add Name:="Picture"
                For i = 1 To .SelectedItems.Count
                    j = Int((i + 1) / 2) * 2 - 1
                    k = (i - 1) Mod 2 + 1
                    'Add extra rows as needed
                    If j > oTbl.Rows.Count Then
                        oTbl.Rows.Add
                        oTbl.Rows.Add
                        Call FormatRows(oTbl, j)
                    End If
                    'Insert the Picture
                    ActiveDocument.InlineShapes.AddPicture _
                        FileName:=.SelectedItems(i), LinkToFile:=False, _
                        SaveWithDocument:=True, Range:=oTbl.Rows(j).Cells(k).Range
                    'Get the Image name for the Caption
                    StrTxt = Split(.SelectedItems(i), "\")(UBound(Split(.SelectedItems(i), "\")))
                    StrTxt = ": " & Split(StrTxt, ".")(0)
                    'Insert the Caption on the row below the picture
                    With oTbl.Rows(j + 1).Cells(k).Range
                        .InsertBefore vbCr
                        .Characters.First.InsertCaption _
                        Label:="Picture", Title:=StrTxt, _
                        Position:=wdCaptionPositionBelow, ExcludeLabel:=False
                        .Characters.First = vbNullString
                        .Characters.Last.Previous = vbNullString
                    End With
                Next
            Else
            End If
        End With
        Application.ScreenUpdating = True
    End Sub
    '
    Sub FormatRows(oTbl As Table, x As Long)
        With oTbl
            With .Rows(x)
                .Height = CentimetersToPoints(7)
                .HeightRule = wdRowHeightExactly
                .Range.Style = "Normal"
            End With
            With .Rows(x + 1)
                .Height = CentimetersToPoints(0.75)
                .HeightRule = wdRowHeightExactly
                .Range.Style = "Caption"
            End With
        End With
    End Sub
    As coded, the paragraph Style for the image rows is set to 'Normal'. I suggest creating another paragraph Style, with 0 space before and after, plus the 'Keep with next' attribute, and using that instead of the 'Normal' Style.
    Last edited by macropod; 12-04-2022 at 12:43 AM.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

Posting Permissions

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