VBA 从 excel 复制到 word 文档时代码崩溃：错误 4605

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

改动说明：

创建了两个工作sheet 变量，Phys 和 Tri，以保存对“物理”和“三部曲输出”sheet 的引用。这可以让我们从那些 sheet 中获取范围而无需选择它们。
创建了范围对象 CurrentCell 以跟踪正在复制的“物理”sheet 中的范围。声明范围允许我们最小化写入常量“A12”的次数。如果以后需要编辑，这会简化事情。
NumRows 和 x 从 Integer 更改为 Long，因为 Excel 行号有可能导致 Integers 溢出错误。
使用 Range.Copy 的 Destination 参数允许我们在同一个 Excel 应用程序中的 sheet 之间复制时跳过使用剪贴板。这比使用剪贴板快得多，而且更可靠，因为我们消除了对 Selection.

.Copy

DoEvents。 @TimothyRylatt 提到这可以帮助解决剪贴板需要时间来完成处理的问题。
.Cells(2) 与 .Offset(1,0) 相同，用于将单元格向下移动 1。但是我遇到了 Offset 的问题，我宁愿尽可能避免使用它。

VBA 从 excel 复制到 word 文档时代码崩溃：错误 4605

VBA code crashing when copying from excel to word doc : error 4605

excel

vba

ms-word

copy-paste