Thanks for adding me in to forum
I'm looking for help with a Word macro that could do the following:
Adding multiple photos from the folder with file name above the picture without any other information Like (Picture 3: filename ). we just need the file name.
Also filename want to be in same cell.
this script work for my need. but i need the file name above the mage without any other information.
I Appreciate any help.
#
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, 1, 2)
With oTbl
.AutoFitBehavior (wdAutoFitFixed)
.Columns.Width = CentimetersToPoints(7)
End With
For i = 1 To .SelectedItems.Count
'Add extra rows as needed
With oTbl
If i > .Rows.Count Then oTbl.Rows.Add
With .Rows(i)
.Height = CentimetersToPoints(7)
.HeightRule = wdRowHeightExactly
.Range.Style = "Normal"
.Cells(1).Range.Text = vbCr
.Cells(1).Range.Characters.Last.Style = "Caption"
End With
End With
'Insert the Picture
ActiveDocument.InlineShapes.AddPicture FileName:=.SelectedItems(i), _
LinkToFile:=False, SaveWithDocument:=True, _
Range:=oTbl.Cell(i, 1 - 2).Range.Characters.First
'Get the Image name for the Caption
StrTxt = Split(.SelectedItems(i), "")(UBound(Split(.SelectedItems(i), "")))
StrTxt = ": " & Split(StrTxt, ".")(0)
'Insert the Caption on the line below the picture
With oTbl.Cell(i, 1 - 2).Range
.Characters.Last.Previous.InsertCaption Label:="Picture", Title:=StrTxt, _
Position:=wdCaptionPositionBelow, ExcludeLabel:=1
.Characters.Last.Previous = vbNullString
End With
Next
Else
End If
End With
Application.ScreenUpdating = True
End Sub
looking to get something like this