Hi.

I want to populate a Word document with images obtained from a specific folder and insert them one by one page by page.

My code gives me the first part (getting images from a specific folder), but it fails miserably at placing them image by image, page by page, because it ends up placing some images spaced out and others, for some reason I don't know, it adds several on top of each other at the end of the document (!!).

I've tried everything and the closest I've come is the code reproduced below. I'm also showing an image that gives you a better idea of the mess the images in the document are in.



The code:


Sub Insert_Images_Bilder_Import()



Dim Path As String

Dim fs As Object

Dim ff As Variant

Dim Img As Variant

Dim i As Long

Dim fsize As Long

Dim Shp As shape

Dim Rng As Range



Path = "C:\Users\L\Pictures"

Set fs = CreateObject("Scripting.FileSystemObject")

Set ff = fs.GetFolder(Path).Files

i = 0

fsize = ff.count



With ActiveDocument



For Each Img In ff

Select Case Right(Img.Name, 4)

Case ".bmp", ".jpg", ".gif", ".png"

i = i + 1

Set Shp = ActiveDocument.shapes.AddPicture(FileName:=Img, _

LinkToFile:=False, SaveWithDocument:=True, Width:=CentimetersToPoints(18), Height:=CentimetersToPoints(25), Anchor:=Selection.Range)



With Shp

.LockAspectRatio = False

.RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin

.RelativeVerticalPosition = wdRelativeVerticalPositionMargin

.RelativeHorizontalSize = wdRelativeHorizontalSizeMargin

.RelativeVerticalSize = wdRelativeVerticalSizeMargin

.Left = wdShapeCenter

.LeftRelative = wdShapePositionRelativeNone

.Top = wdShapeTop

.TopRelative = wdShapePositionRelativeNone

.WidthRelative = wdShapeSizeRelativeNone

.HeightRelative = wdShapeSizeRelativeNone

.LockAnchor = False

.LayoutInCell = True

.WrapFormat.AllowOverlap = True

.WrapFormat.Side = wdWrapBoth

.WrapFormat.DistanceTop = MillimetersToPoints(0)

.WrapFormat.DistanceBottom = MillimetersToPoints(0)

.WrapFormat.DistanceLeft = MillimetersToPoints(120)

.WrapFormat.DistanceRight = MillimetersToPoints(120)

.WrapFormat.Type = wdWrapTight

.Line.Visible = True

.Line.Style = msoLineSingle

.Line.Weight = 0.5

.Line.ForeColor.RGB = RGB(102, 51, 0)



End With



[Here begins my problem!]



Selection.TypeParagraph

Selection.Collapse Direction:=wdCollapsEnd

Selection.InsertBreak Type:=wdPageBreak





End Select

Next



End With



Application.ScreenUpdating = True



End Sub



Thank you for your assistance!

Attached Images

[Word Macro VBA] There are three images here, one above (an)other.jpg (45.0 KB, 7 views)

See: https://www.msofficeforums.com/drawi...-document.html

__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]