PDA

View Full Version : [SOLVED:] Insert images in a specific row in a word table



angelje
02-06-2017, 02:43 AM
Hello!

I am new in word vba and I need some help to do my first code.

I have a table in word 2010, with three columns and I need to insert images from a windows folder in the third column of all rows, one image per row. The first row is the header row. In the first and second column there are information about the images, this is why I need the image in the third column.

I would like to be able to choose the folder in which the images are and from here, the code will automatically insert the images in the third column of all the rows of the table in the same order that the images are in the windows folder.

I need to resize the image according to the cell dimensions. With fixed cell dimensions.

Could this be possible?

Thanks in advance.

gmaxey
02-06-2017, 07:33 AM
This is crude but should get you started.


Sub InsertImages()
Dim lngCount As Long, oTbl As Table, oCell As Cell
Dim oRng As Range, oILS As InlineShape
Dim strFolder As String, strFile As String
Application.ScreenUpdating = False
strFolder = GetFolder
If strFolder = "" Then Exit Sub
Set oTbl = ActiveDocument.Tables(1)
oTbl.AutoFitBehavior (wdAutoFitFixed)
strFile = Dir(strFolder & "\*.*", vbNormal)
While strFile <> ""
If InStr(strFile, "jpg") > 0 Or InStr(strFile, "png") > 0 Then 'To filter only jpg and png graphic files
lngCount = lngCount + 1
If lngCount > oTbl.Rows.Count - 1 Then oTbl.Rows.Add
Set oCell = oTbl.Cell(lngCount + 1, 3)
Set oRng = oCell.Range
oRng.Collapse wdCollapseStart
Set oILS = oRng.InlineShapes.AddPicture(FileName:=strFolder & Application.PathSeparator & strFile, _
LinkToFile:=False, SaveWithDocument:=True)
With oILS
'Manipulate to suit
End With
End If
strFile = Dir()
Wend
Application.ScreenUpdating = True
lbl_Exit:
Exit Sub
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function



But to really get started, you have to write some code.

Sub Help()
Msgbox "What do I next"
End Sub

Is better than nothing ;-)

angelje
02-06-2017, 09:42 AM
Thank you so much, it works fine!