excel - 从 excel 复制到 word doc : error 4605 时 VBA 代码崩溃

Question

我有一个包含学生论文分数的 excel 文档。
有一个摘要选项卡，可将分数整理成对学生更有用的格式。
我拼凑了一些 VBA 代码，这些代码打开一个 word 文档，然后逐步浏览每个学生的记录，复制输出页面并将其放到 word 文档中。
代码运行并执行它应该做的事情，除了中途失败，每次都在不同的时间点。
我试过 paste 和 pastespecial，都以同样的方式失败，这是调试器指示问题的地方。
错误代码通常是 4605，虽然我有 4198 和运行时错误 -2147023170
希望有大神能帮帮忙!
下面的代码

Sub Trilogy_output()

    Dim x As Integer
    Dim wdApp As Word.Application
    
        ' openword fdoc
    Set wdApp = New Word.Application
    With wdApp
        .Visible = True
        .Activate
        .Documents.Add
    End With
    
       ' Select main data sheet
    Sheets("Physics").Select
    Range("A12").Select

      ' Set numrows = number of rows of data.
    NumRows = Range("A12", Range("A12").End(xlDown)).Rows.Count
      
      ' Select starting cell.
    Range("A12").Select
      
      ' Establish "For" loop to loop "numrows" number of times.
    For x = 1 To NumRows
    
         ' paste name to output sheet
        Selection.Copy
        Sheets("Trilogy Output").Select
        Range("B2").Select
        ActiveSheet.Paste
        
        ' copy sheet to word
        Range("A1:G40").Select
        Selection.Copy
    With wdApp.Selection
        ' .Paste
        .PasteSpecial DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine
        .InsertBreak Type:=7
    End With
    Application.CutCopyMode = False
    ' Selects cell down 1 row from active cell.
    Sheets("Physics").Select
    ActiveCell.Offset(1, 0).Select
    Next
    
Application.ScreenUpdating = True

End Sub

Answer 1

为了提高代码的可靠性，最好不要使用Select和 Selection只要有可能。依托Selection始终指向正确的对象或范围是困惑且难以跟踪的。它也容易出错，因为某些东西可能会在执行过程中被用户或方法无意中选择。
举例说明如何删除 .Select和 .Selection请参阅您的程序的以下编辑版本。

Sub Trilogy_output()
    Application.ScreenUpdating = False

        ' openword fdoc
    Dim wdApp As New Word.Application
    With wdApp
        .Visible = True
        .Activate
        .Documents.Add
    End With
    
       ' main data sheet
    Dim Phys As Worksheet
    Set Phys = ThisWorkbook.Sheets("Physics")

    Dim Tri As Worksheet
    Set Tri = ThisWorkbook.Sheets("Trilogy Output")

    Dim CurrentCell As Range
    Set CurrentCell = Phys.Range("A12") 'Starting Cell

      ' Set numrows = number of rows of data.
    Dim NumRows As Long
    NumRows = CurrentCell.End(xlDown).Row - CurrentCell.Row + 1
      
      ' Establish loop through column "A" of Phys from row 12 to end.
    Dim x As Long
    For x = 1 To NumRows
         ' paste name to output sheet
        CurrentCell.Copy Destination:=Tri.Range("B2")
        
        Tri.Range("A1:G40").Copy
        DoEvents
        With wdApp.Selection
            ' copy sheet to document
            .PasteSpecial DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine
            .InsertBreak Type:=7
        End With
        Application.CutCopyMode = False
        
        'Move the current cell down by 1
        Set CurrentCell = CurrentCell.Cells(2)
    Next
    
    Application.ScreenUpdating = True

End Sub

变更说明:

两个工作表变量，Phys和 Tri ，创建以保存对“物理”和“三部曲输出”表的引用。这可以让我们在不选择它们的情况下从这些工作表中获取范围。

范围对象，CurrentCell , 创建用于跟踪正在复制的“物理”表中的范围。声明范围允许我们最小化写入常量“A12”的次数。如果以后需要编辑，这可以简化事情。

NumRows和 x已从整数更改为长整数，因为 Excel 行号有可能导致整数溢出错误。

使用 Destination Range.Copy 的论点允许我们在同一个 Excel 应用程序中的工作表之间复制时跳过使用剪贴板。这比使用剪贴板快得多，而且更可靠，因为我们消除了对 Selection 的依赖。 .

DoEvents在 .Copy 之后添加. @TimothyRylatt 提到这可以帮助解决剪贴板需要时间来完成处理的问题。

.Cells(2)与 .Offset(1,0) 相同将单元格向下移动 1。但我遇到了 Offset 的问题并且尽可能避免使用它。