#1
|
|||
|
|||
Word Macro VBA | Insert images one by one, page by page
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! Last edited by leonelcd; 11-02-2023 at 07:36 AM. |
#2
|
||||
|
||||
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Insert mutliple digital images on one page | 2whldreams | Word VBA | 29 | 08-18-2022 03:21 PM |
Macro to insert footer on one page only | DRD992 | Word VBA | 1 | 08-29-2021 06:20 PM |
I need a macro to automatically insert 4 pics per page in a word document with "Photograph No 1, 2," | NewbieLearning | Word VBA | 15 | 11-14-2017 05:03 AM |
Macro to insert Landscape page | Catty | Word VBA | 1 | 05-05-2014 03:42 AM |
Macro to insert new page... | samanthaj | Word | 17 | 01-31-2012 01:53 PM |