Inserting pictures in Word via VBA

[refer94]

Hey all,

I'm pretty new regarding VBA and macro so i hope that someone can help me.

I work with a lot of pictures and it can be difficult to arrange them and very time consumeing when it's sometimes 200+. I'm trying to make a code that can put them all in at once and arrange them for me.

I want my code to do the following.
1. Insert all pictures from a folder without having to individually select them all.
2. Scale all pictures to 450x450. (Can always be changed)
3. Insert the pictures, 2 on each word page (Landscape) and right centre the first and left centre the second.


So far i have made a code which does number 1 and 2 but i can't seem to figure out how to do number 3. Do i have to make som boxes for guidance?

Really hope you can help me. Kind regards


Thomas

This is my code so far if it helps anybody.


Sub InsertImages()
Dim intResult As Integer
Dim strPath As String
Dim strFolderPath As String
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer


'the dialog is displayed to the user
intResult = Application.FileDialog(msoFileDialogFolderPicker).Show
'checks if user has cancled the dialog
If intResult <> 0 Then
'dispaly message box
strFolderPath = Application.FileDialog(msoFileDialogFolderPicker _
).SelectedItems(1)
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(strFolderPath)
i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'get file path
strPath = objFile.path
'insert the image
Selection.InlineShapes.AddPicture FileName:= _
strPath, LinkToFile:=False, _
SaveWithDocument:=True
Next objFile
With ActiveDocument
For i = 1 To .InlineShapes.Count
With .InlineShapes(i)
.ScaleHeight = 55
.ScaleWidth = 60
End With
Next i
End With
End If
End Sub

[gmayor]

http://www.gmayor.com/photo_gallery_template.html does more or less what you want, with the images in a table, the size of which is determined by the margins of the document you are inserting the images into. You can use either a two column format into a single column document or a 1 column table into a two column document (should you want to increase the spacing between the images).

Whether you use the template or create your own process, using a table to place the images is the way forward. Create a one row table with three cells formatted as required in the document (save this as an building block for ease of re-use) then add a row for every two images in your loop. Three columns are used to space the left and right image columns and the first and last columns set the width of the images


Sub InsertImages()
Dim strPath As String
Dim fDialog As FileDialog
Dim strFile As String
Dim i As Long
Dim oTable As Table
Dim oCell As Range

'the dialog is displayed to the user
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.Title = "Select folder and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User", , "List Folder Contents"
Exit Sub
End If
strPath = fDialog.SelectedItems.Item(1)
If Right(strPath, 1) <> "\" Then strPath = strPath + "\"
End With

Set oTable = ActiveDocument.Tables.Add(ActiveDocument.Range, 1, 3)
With oTable
.Columns(1).Width = CentimetersToPoints(5)
.Columns(2).Width = CentimetersToPoints(13.5)
.Columns(3).Width = CentimetersToPoints(5)
End With
strFile = Dir$(strPath & "*.jpg") 'change the extension to match your images
i = 0
While strFile <> ""
i = i + 1
If i Mod 2 = 0 Then
Set oCell = oTable.Rows.Last.Cells(3).Range
oTable.Rows.Add
Else
Set oCell = oTable.Rows.Last.Cells(1).Range
End If
oCell.End = oCell.End - 1
oCell.InlineShapes.AddPicture FileName:= _
strPath & strFile, _
LinkToFile:=False, _
SaveWithDocument:=True
strFile = Dir$()
Wend
End Sub

[refer94]

You are the real MVP. Thanks man. Really appreciate it!