Microsoft Office Forums - View Single Post - Pages

MAtkins · 07-27-2016, 08:36 AM

I've got a user determined (from a form) number of images to add to an existing docm file.
I need to add a page below the page the cursor is on and then add the images to that and if needed subsequent new pages.

Each page should have 3 columns (a table) with one image in each and as many rows as are needed (4 rows per page). The images are to be a specific width & height.

I've tried many different approaches and no matter what I do, Word puts the images where it feels they should go without regard to my code, often on the same page the cursor is on.
Also, it adds another blank page for no reason that I can see.

How can I make Word do what I need?

Below is my last attempt.

Code:

Public Sub insertSectionPics()
    Dim nPicsPage1 As Integer, nPicsPage As Integer, tblPics As Table, nRows As Integer, nPages As Integer, oPic As Word.InlineShape
    Dim tblCell As Cell
    Dim tblRow As Row
    Dim i As Integer, x As Integer, nIdx As Integer, nInch As Integer, nWidth As Integer, nHeight As Integer
    Dim nRects As Long
    Dim oRange As Word.Range, oRngCaption As Word.Range
    
    nWidth = 172
    nHeight = 129
    nInch = 72 'Points
    nIdx = -1
    
    If Not IsVarArrayEmpty(arSectionPics) Then
        If arSectionPics(0) <> "" And sSelPage <> "" Then
            nPicsPage1 = CInt(sSelPage)
            nPicsPage = nPicsPage1 + 1
            
            nRows = Round(((UBound(arSectionPics) + 1) / 3) + 0.4, 0)
            
            Selection.GoToNext wdGoToPage
            Selection.GoTo What:=wdGoToLine, Which:=wdGoToPrevious
            Selection.InsertNewPage
            Selection.GoTo What:=wdGoToLine, Which:=wdGoToPrevious
            Selection.Text = "Add Pics Table"
                        
            Selection.Find.Text = "Add Pics Table"
            Set oRange = ActiveDocument.Content
            oRange.Find.Execute FindText:="Add Pics Table", Forward:=True
            
            Set tblPics = ActiveDocument.Tables.Add(Range:=oRange, NumRows:=nRows, NumColumns:=3)
            tblPics.Columns.DistributeWidth
            
            For i = 1 To tblPics.Rows.Count
                Set tblRow = tblPics.Rows(i)
                tblRow.Cells.VerticalAlignment = wdCellAlignVerticalTop
                tblRow.Height = nHeight + 16
                For x = 1 To 3
                    nIdx = nIdx + 1
                    If nIdx <= UBound(arSectionPics) Then
                        Set tblCell = tblRow.Cells(x)
                        tblCell.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
                        Set oPic = tblCell.Range.InlineShapes.AddPicture(FileName:=arSectionPics(nIdx), LinkToFile:=False, SaveWithDocument:=True)
                        oPic.Height = nHeight 'Points
                        oPic.Width = nWidth 'Points
                                                
                        Set oRngCaption = ActiveDocument.Range(tblCell.Range.End - 1, tblCell.Range.End)
                        oRngCaption.ParagraphFormat.Alignment = wdAlignParagraphCenter
                        oRngCaption.Font.Bold = False
                        oRngCaption.Font.Name = "Arial"
                        oRngCaption.Font.Size = 9
                        
                        If arSectionPicCaptions(nIdx) <> "" Then
                            oRngCaption.Text = arSectionPicCaptions(nIdx) 'vbCrLf &
                        Else
                            oRngCaption.Text = " "
                        End If
                    End If
                Next
            Next
        End If
    End If
    
    bTablesLoaded = False
    fmSectionPics.Hide
    Set fmSectionPics = Nothing
End Sub