Question

我试图将数字作为数字复制到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

Answer 1

使用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

将动态Excel范围复制到Word作为图

1 个答案: