Log in

View Full Version : [SOLVED:] Inserting Images Into a Word Document with VBA



mongoose
10-31-2019, 06:11 AM
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

mongoose
10-31-2019, 06:54 AM
Fixed it with:



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

macropod
11-01-2019, 11:28 PM
Cross-posted (and solved by barneyos) at: https://stackoverflow.com/questions/58643827/inserting-images-into-a-word-document-with-vba
Please read VBA Express' policy on Cross-Posting in Rule 3: http://www.vbaexpress.com/forum/faq.php?faq=new_faq_item#faq_new_faq_item3