Word macro: Add photos as a list

Date 14.05.2016

Word macro: Add photos as a list

With this macro, you can select photos from your photo directory and automatically paste it into Word.

The photos are automatically adapted to the width of the page of your Word document and converted into a small storage format.

While the photos are reduced size of approximately 4 MB 0.5 MB memory allowing Word further use.

The photos as small thumbnails in the subfolder of the Word document available are also when storing the Word as Word.html.

As a video tutorial, how the macro works:

Here the macro code to insert into your Word document as your own macro

Public Sub a0_Insert_Photos_by_Selection()

'-----------------< a0_Insert_Photos_by_Selection() >-----------------

'--< Import-Dialog >--

Dim objFiledialog As FileDialog

Set objFiledialog = Application.FileDialog(msoFileDialogFilePicker)

objFiledialog.AllowMultiSelect = True

objFiledialog.ButtonName = "Import Images"

objFiledialog.Filters.Add "Images Photos", "*.jpg"

objFiledialog.Title = "Select the photos.."

If Not objFiledialog.Show() = True Then

Exit Sub

End If

'--< Import-Dialog >--

'--< Kontrolle >--

'</ Ordner ist leer >

If objFiledialog.SelectedItems().Count = 0 Then

Exit Sub

End If

'</ Ordner ist leer >

Selection.TypeParagraph

On Error Resume Next

'-------< @Loop: Insert all Images >--------

Dim objInlineShape As InlineShape

Dim sFilename As String

Dim iFile As Integer

Dim iMax As Integer

iMax = objFiledialog.SelectedItems.Count

For iFile = 1 To iMax Step 1

'------< Loop.Item >------

DoEvents

'< get selection >

sFilename = objFiledialog.SelectedItems(iFile)

'</ get selection >

'----< Insert Image >----

'< insert picture from Link >

Set objInlineShape = ActiveDocument.InlineShapes.AddPicture(FileName:=sFilename, LinkToFile:=False, SaveWithDocument:=True)

'</ insert picture from Link >

'--< replace as png >--

'*reduce memory 1 MB to 1kb

'< cut >

objInlineShape.Select

Selection.Cut

'</ cut >

'*pasteBitmap is much smaller

Selection.PasteSpecial Link:=False, DataType:=wdPasteBitmap, Placement:=wdInLine, DisplayAsIcon:=False

'--</ replace as png >--

'< add spacer >

Selection.TypeParagraph

Selection.TypeText Text:=" "

'</ add spacer >

If Err.Number <> 0 Then

MsgBox Err.Description

Err.Clear

End If

'----</ Insert Image >----

'------</ Loop.Item >------

'-------</ @Loop: Insert all Images >--------

'-------< @Loop: create all JPG Thumbnails >--------

'*create png Bitmaps and jpg thumbnails when saved as website

For Each objInlineShape In ActiveDocument.InlineShapes

objInlineShape.Line.Style = msoLineSingle

objInlineShape.Line.Weight = 1

'-------</ @Loop: create all JPG Thumbnails >--------

'-----------------</ a0_Insert_Photos_by_Selection() >-----------------

End Sub

You will find the very small thumbnails in the subdirectory of your Word document if her this as word.html stores.