Hi excel masters,

I'm very new to VBA (this is my first post) and I'm trying to write a complicated code that will select a varying number of 32 row x 8 column boxes and paste them into a new word document as bitmap images, one on each page. I'm also trying to format each bitmap picture with a plain black border of 1.5 pt weight.

The code I have now can open up a new Word document and paste the first 26 ranges, but then it gives me an error and won't paste any more ranges. Also, none of the coding that I have tried today has succeeded in formatting an outline on the pictures.

Is anyone able to help me fix either of these issues? I'm at a loss for how to proceed. Here is the code I have been using:

Option Explicit


Sub WordCopyPaste3()


    Const wdWindowStateMaximize As Integer = 1
    Const wdPasteBitmap As Integer = 4
    Const wdPageBreak As Integer = 7
    Dim WordApp As Object
    Dim WordDoc As Object
    Dim TotalCmp As Integer
    Dim oShape As Shape
    
    On Error GoTo CopyPaste_Error


' Finding the total number of ranges to paste (a variable number):
    ActiveWorkbook.Sheets("Inputs").Select
    ActiveSheet.Range("A1").Select
    Cells.Find(What:="Minimum Funding", After:=ActiveCell, LookIn:=xlFormulas _
        , LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=True, SearchFormat:=False).Activate
    ActiveCell.Offset(0, -1).Range("A1").Select
    Selection.End(xlUp).Select
    TotalCmp = ActiveCell.Range("A1").Value
         
' Opening a new Word Document
    Set WordApp = CreateObject("Word.Application")
        With WordApp
        .Visible = True
        .WindowState = wdWindowStateMaximize
        End With
    Set WordDoc = WordApp.Documents.Add
           
' Selecting the first range
    ActiveWorkbook.Sheets("Components").Select
    ActiveSheet.Range("B3").Select
    
' A running count for each range is one column over from the top left of the range to paste
    Do While ActiveCell.Offset(0, 1).Range("A1").Value <= TotalCmp And ActiveCell.Offset(0, 1).Range("A1").Value > 0
        ActiveCell.Range("A1:H31").Copy
            With WordApp
                .Selection.PasteSpecial DataType:=wdPasteBitmap 'I get an error on this line on the 27th range, although there are 32 ranges total
                .Selection.InsertBreak Type:=wdPageBreak
            End With
        Application.CutCopyMode = False
        ActiveCell.Offset(34, 0).Select
    Loop
    
' Exit code
    On Error GoTo 0
    Set WordApp = Nothing
    Set WordDoc = Nothing
    Set oShape = Nothing
    Exit Sub

' Error code
CopyPaste_Error:
    MsgBox "Module 21 Copy Paste Error", vbCritical, "ERROR"
    On Error GoTo 0


End Sub