Vba 将动态Excel范围复制到Word，如图所示

我正在尝试将Excel动态范围作为数字复制到Word文档中，该范围会随着情况的变化而变化

第一个工作表将是用户放置输入的地方。与第四张工作表相比，将对每行输入进行一些计算。我想做的是将第四个工作表的内容复制到word文档中，直到最后一个输入行。问题是，最后一个输入行号将根据具体情况进行更改

另一个困难是，每个单词页面只有45行的空间，因此如果输入超过该数字，则需要将其拆分为多个页面

我有适用于静态范围的代码，我想更改为也适用于动态范围

Sub copyword()
   Dim objWord As Object, objDoc As Object, Rng As Object
   Dim wb As Workbook
   Dim n As Integer

   Set wb = ActiveWorkbook

   'see if Word is already open
   On Error Resume Next
   Set objWord = GetObject(, "Word.Application")
   On Error GoTo 0

   'not open - create a new instance and add a document
   If objWord Is Nothing Then
       Set objWord = CreateObject("Word.Application")
       objWord.Visible = True
       objWord.documents.Add
   End If

   Set objDoc = objWord.activedocument
   Set Rng = objWord.Selection

   Worksheets(2).Activate
   ActiveWindow.View = xlNormalView
   wb.Worksheets(2).Range("A1:O47").CopyPicture Appearance:=xlScreen, Format:=xlPicture
   Rng.Paste
   Rng.typeparagraph
   ActiveWindow.View = xlPageBreakPreview

   Worksheets(2).Activate
   ActiveWindow.View = xlNormalView
   wb.Worksheets(2).Range("U1:AI47").CopyPicture Appearance:=xlScreen, Format:=xlPicture
   Rng.Paste
   Rng.typeparagraph
   ActiveWindow.View = xlPageBreakPreview
End Sub

---

要确定A列中数据的最后一行（未测试）：

Sub copyword()
   Dim objWord As Object, objDoc As Object, Rng As Object
   Dim wb As Workbook, n As Integer, lr As Long

   Set wb = ActiveWorkbook
   On Error Resume Next 'see if Word is already open
   Set objWord = GetObject(, "Word.Application")
   On Error GoTo 0

   If objWord Is Nothing Then   'not open - create a new instance and add a document
       Set objWord = CreateObject("Word.Application")
       objWord.Visible = True
       objWord.documents.Add
   End If
   Set objDoc = objWord.activedocument
   Set Rng = objWord.Selection
   With wb.Worksheets(2)

      'determine last row *****************************************
      lr = .Cells("A" & .UsedRange.Row + .UsedRange.Rows.Count).End(xlUp)

      .Activate
         ActiveWindow.View = xlNormalView
         'use last row *********************************************************
         .Range("A1:O" & lr).CopyPicture Appearance:=xlScreen, Format:=xlPicture
         Rng.Paste
         Rng.typeparagraph
         ActiveWindow.View = xlPageBreakPreview
      .Activate
         ActiveWindow.View = xlNormalView
         'use last row **********************************************************
         .Range("U1:AI" & lr).CopyPicture Appearance:=xlScreen, Format:=xlPicture
         Rng.Paste
         Rng.typeparagraph
         ActiveWindow.View = xlPageBreakPreview
   End With
End Sub