![]() |
#1
|
|||
|
|||
![]()
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 Last edited by Prasadj; 02-07-2023 at 06:07 PM. |
![]() |
Tags |
word vba |
Thread Tools | |
Display Modes | |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
henhelm | Word VBA | 15 | 02-07-2023 05:35 PM |
![]() |
macaronipasta | Word VBA | 2 | 06-27-2021 06:28 PM |
Macro to insert multiple photos into separate tables | Photoinserts | Word VBA | 0 | 11-12-2018 08:30 PM |
![]() |
Mr M | Drawing and Graphics | 2 | 06-20-2018 08:07 PM |
![]() |
Jeremiahts | Drawing and Graphics | 1 | 03-23-2011 07:33 PM |