I needed a printed catalog of GIF images in a directory. So I wrote a routine that creates a new document, and inserts an image for each GIF file in the directory, along with its name and size. When the routine has finished, you can print or save the document:
Sub ImageCat() Dim sDir As String Dim sFileName As String Dim sHeight As Single Dim sWidth As Single Dim oShape As InlineShape ' This directory contains images sDir = "D:WEBSprogramming\_THEMESMODULAR" Documents.Add ' create new doc ' set left/right margins With ActiveDocument.PageSetup .LeftMargin = InchesToPoints(1) .RightMargin = InchesToPoints(1) End With ' Set Header/Footer text With ActiveDocument.Sections(1) .Headers(wdHeaderFooterPrimary) _ .Range.InsertAfter ("Listing of " _ & LCase$(sDir)) .Footers(wdHeaderFooterPrimary _ ).PageNumbers.AddPageNumberAlignment: _ =wdAlignPageNumberRight End With ChangeFileOpenDirectory sDir sFileName = Dir("*.gif") ' loop thru each file Do Until sFileName = "" 'add some extra space Selection.ParagraphFormat.SpaceBefore = 12 'Insert image Set oShape = Selection.InlineShapes. _ AddPicture(FileName:=sDir _ & sFileName, LinkToFile:=False, _ SaveWithDocument:=True) ' show image @ 100% oShape.ScaleHeight = 100 oShape.ScaleWidth = 100 ' Get height and width sHeight = oShape.Height * 4 sWidth = oShape.Width * 4 sHeight = sHeight 3 sWidth = sWidth 3 ' print filename & size Selection = vbTab & LCase$(sFileName) & " _ [" & CInt(sWidth) & _ " x " & CInt(sHeight) & "]" Selection.InsertParagraphAfter Selection.Collapse (wdCollapseEnd) ' next file sFileName = Dir LoopEnd Sub
This code does not check whether the image fits on the page; in my case all the images were small, such as Web buttons and rules.