Word Macro VBA

leonelcd · #1 11-01-2023, 10:24 PM

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:

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!

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Insert mutliple digital images on one page	2whldreams	Word VBA	31	05-07-2025 03:07 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