Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 05-01-2018, 02:45 PM
Kass Kass is offline Insert multiple images in table with filename in column to the side Windows 7 64bit Insert multiple images in table with filename in column to the side Office 2016
Novice
Insert multiple images in table with filename in column to the side
 
Join Date: May 2018
Posts: 2
Kass is on a distinguished road
Default Insert multiple images in table with filename in column to the side

Hello!

I need to create a document that has 4 columns with a picture in the last column (4), and its filename in the column to the left (3). (The first two columns have data that I'll need to import individually rather than in a batch process.) I'll need to import at least 1000 pictures for my report, so any way that I can save some time would be awesome.

I've tried using the following module that I found on Microsoft's technet, and it works for adding the pictures, but I can't figure out how to implement the modifications that I want. Basically, I want a "caption" that shows up in a different column that only contains the filename. (I also want the pictures to only be about 2 inches high, but I think I can modify that by changing "max_height" below, right?) Is what I want to do possible? Any advice? I really don't want to have to drag the text from the caption to a separate column for 1000+ pictures.

Thanks in advance for any help!

Module:

Sub InsertMultipleImagesFixed()
Dim fd As FileDialog
Dim oTable As Table
Dim iRow As Integer
Dim iCol As Integer
Dim oCell As Range
Dim i As Long
Dim sNoDoc As String
Dim picName As String
Dim scaleFactor As Long
Dim max_height As Single
'define resize constraints
max_height = 275

'add a 1 row 2 column table to take the images
Set oTable = Selection.Tables.Add(Selection.Range, 1, 1)
'+++++++++++++++++++++++++++++++++++++++++++++
'oTable.AutoFitBehavior (wdAutoFitFixed)
oTable.Rows.Height = CentimetersToPoints(4)
oTable.Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter
'++++++++++++++++++++++++++++++++++++++++++++++

Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Title = "Select image files and click OK"
.Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png; *.wmf"
.FilterIndex = 2
If .Show = -1 Then

For i = 1 To .SelectedItems.Count

iCol = 1


iRow = i
'get filename
picName = Right(.SelectedItems(i), Len(.SelectedItems(i)) - InStrRev(.SelectedItems(i), "\"))
'remove extension from filename ****
picName = Left(picName, InStrRev(picName, ".") - 1)

'select cell
Set oCell = ActiveDocument.Tables(1).Cell(iRow, iCol).Range

'insert image
oCell.InlineShapes.AddPicture FileName:= _
.SelectedItems(i), LinkToFile:=False, _
SaveWithDocument:=True, Range:=oCell

'resize image
If oCell.InlineShapes(1).Height > max_height Then
scale_factor = oCell.InlineShapes(1).ScaleHeight * (max_height / oCell.InlineShapes(1).Height)
oCell.InlineShapes(1).ScaleHeight = scale_factor
oCell.InlineShapes(1).ScaleWidth = scale_factor
End If

'center content
oCell.ParagraphFormat.Alignment = wdAlignParagraphCenter

'insert caption below image
oCell.InlineShapes(1).Range.InsertCaption Label:="Figure", TitleAutoText:="", _
Title:=": " & picName
If i < .SelectedItems.Count And i Mod 2 = 0 Then 'add another row, more to go
oTable.Rows.Add
End If
Next i
End If
End With

Set fd = Nothing
End Sub
Reply With Quote
  #2  
Old 05-02-2018, 07:29 PM
jjfreedman jjfreedman is offline Insert multiple images in table with filename in column to the side Windows 10 Insert multiple images in table with filename in column to the side Office 2016
Advanced Beginner
 
Join Date: May 2012
Location: https://jay-freedman.info
Posts: 39
jjfreedman is on a distinguished road
Default

Try this.

Code:
Sub InsertMultipleImagesFixed()
Dim fd As FileDialog
Dim oTable As Table
Dim iRow As Integer
Dim iCol As Integer
Dim oCell As Range
Dim i As Long
Dim sNoDoc As String
Dim picName As String
Dim scale_Factor As Long
Dim max_height As Single
'define resize constraints
max_height = 144  ' 2 inches = 144 pt

'add a 1 row 4 column table to take the images
Set oTable = Selection.Tables.Add(Selection.Range, 1, 4)
'+++++++++++++++++++++++++++++++++++++++++++++
'oTable.AutoFitBehavior (wdAutoFitFixed)
oTable.Rows.Height = InchesToPoints(2.1)
oTable.Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter
'++++++++++++++++++++++++++++++++++++++++++++++

Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Title = "Select image files and click OK"
.Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png; *.wmf"
.FilterIndex = 2
If .Show = -1 Then

For i = 1 To .SelectedItems.Count

iCol = 4
iRow = i
'get filename
'picName = Right(.SelectedItems(i), Len(.SelectedItems(i)) - InStrRev(.SelectedItems(i), "\"))
''remove extension from filename ****
'picName = Left(picName, InStrRev(picName, ".") - 1)
picName = WordBasic.FilenameInfo(.SelectedItems(i), 4)

'select cell
Set oCell = ActiveDocument.Tables(1).Cell(iRow, iCol).Range

'insert image
oCell.InlineShapes.AddPicture FileName:= _
.SelectedItems(i), LinkToFile:=False, _
SaveWithDocument:=True, Range:=oCell

'resize image
If oCell.InlineShapes(1).Height > max_height Then
scale_Factor = oCell.InlineShapes(1).ScaleHeight * (max_height / oCell.InlineShapes(1).Height)
oCell.InlineShapes(1).ScaleHeight = scale_Factor
oCell.InlineShapes(1).ScaleWidth = scale_Factor
End If

'center content
oCell.ParagraphFormat.Alignment = wdAlignParagraphCenter

'insert caption in column 4, then move it to column 3
oCell.InlineShapes(1).Range.InsertCaption Label:="Figure", TitleAutoText:="", _
Title:=": " & picName
oCell.Paragraphs(2).Range.Cut
ActiveDocument.Tables(1).Cell(iRow, iCol - 1).Range.Paste
If i < .SelectedItems.Count Then  'add another row, more to go
oTable.Rows.Add
End If
Next i
End If
End With

Set fd = Nothing
End Sub
Reply With Quote
  #3  
Old 05-03-2018, 08:14 AM
Kass Kass is offline Insert multiple images in table with filename in column to the side Windows 7 64bit Insert multiple images in table with filename in column to the side Office 2016
Novice
Insert multiple images in table with filename in column to the side
 
Join Date: May 2018
Posts: 2
Kass is on a distinguished road
Default

This is exactly what I had in mind. Thank you so much!
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Insert multiple images at once from a folder beyondimage Excel 1 02-01-2017 12:58 AM
Insert multiple images in table with filename in column to the side Insert multiple images & controls into a document vanwijnen Word VBA 1 06-05-2015 06:16 AM
Insert multiple images in table with filename in column to the side Insert different images to multiple labels Ravon Word 3 10-16-2014 01:13 PM
Insert multiple images in table with filename in column to the side Insert values from multiple rows based on value in one column pachmarhi Excel 3 07-18-2014 09:57 PM
Insert multiple images in table with filename in column to the side I need to paste two images from a PDF side by side into word eof Word 15 04-10-2014 08:12 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 11:00 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft