CODEWITHSUNDEEP
vbams-word
mongoose00318
mongoose00318

Reputation: 131

Inserting Images Into a Word Document with VBA

I'm reusing some VBA code to insert a batch of images into a Word document. The VBA creates a table and then inserts the images as well as a description above each image; which at the moment is the filename of the image.

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

                'MsgBox (.SelectedItems(i).DateLastModified)


                '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

I'm not very familiar with the Application.FileDialog object. I'm still quite a novice with VBA in my opinion. Is there a way to pull the LastModifiedDate of each image and put that into the document in place of the filename as it is currently doing?

Thank you SF

Upvotes: 0

Views: 4135

Answers (2)

barneyos
barneyos

Reputation: 586

You may add/use to For loop this code:

Dim fs as Object
Set fs = CreateObject("Scripting.FileSystemObject")
debug.Print fs.GetFile(.SelectedItems(i)).DateLastModified

Upvotes: 1

Peter B
Peter B

Reputation: 1

I have used the above and get great results for a 2 column table and have deduced how to get a 3 columns table but cannot figure how to get the images to load into the 3 columns, whatever I change either breaks the code or just inserts as two columns or randomly fills 1 or 2 images per row.

Thanks

Peter

Upvotes: -2

Related Questions