VBA从Excel复制内容到Word时报错4605崩溃如何解决？

• 跨应用剪贴板异步延迟：Excel完成复制操作后，剪贴板内容同步需要时间，代码直接执行粘贴操作时Word还未识别到剪贴板中的有效内容，触发4605/4198类报错
• 依赖活动对象操作：大量使用Select/Selection，运行过程中焦点切换、用户误操作都会打断执行流程
• 无显式对象引用：未绑定Word文档对象、变量未声明，容易触发COM组件调用异常的-2147023170报错

Option Explicit
' 如需调整等待时间可以修改这个常量，单位秒
Const WAIT_TIME As Single = 0.2

Sub Trilogy_output()
    Dim x As Integer
    Dim NumRows As Integer
    Dim wdApp As Word.Application
    Dim wdDoc As Word.Document
    Dim shtPhysics As Worksheet
    Dim shtOutput As Worksheet
    
    ' 提前绑定工作表对象，避免反复切换Select
    Set shtPhysics = ThisWorkbook.Sheets("Physics")
    Set shtOutput = ThisWorkbook.Sheets("Trilogy Output")
    
    ' 初始化Word应用和文档
    Set wdApp = New Word.Application
    With wdApp
        .Visible = True
        .Activate
        Set wdDoc = .Documents.Add ' 显式绑定新建的文档
    End With
    
    ' 获取数据行数，无需选中单元格
    NumRows = shtPhysics.Range("A12", shtPhysics.Range("A12").End(xlDown)).Rows.Count
    
    Application.ScreenUpdating = False ' 关闭屏幕刷新加快运行速度
    
    For x = 1 To NumRows
        ' 复制学生姓名到输出表，无需Select
        shtPhysics.Range("A12").Offset(x - 1, 0).Copy shtOutput.Range("B2")
        
        ' 复制输出区域
        shtOutput.Range("A1:G40").Copy
        
        ' 等待剪贴板同步，释放系统资源
        Dim start As Single
        start = Timer
        Do While Timer < start + WAIT_TIME
            DoEvents
        Loop
        
        ' 执行粘贴和分页
        With wdApp.Selection
            .PasteSpecial DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine
            .InsertBreak Type:=wdPageBreak ' 用常量代替魔数7，可读性更强
        End With
        
        ' 清空剪贴板
        Application.CutCopyMode = False
        DoEvents
    Next
    
    ' 资源释放
    Set wdDoc = Nothing
    Set wdApp = Nothing
    Application.ScreenUpdating = True
    MsgBox "导出完成！", vbInformation
End Sub

• 运行前请打开VBA编辑器（快捷键Alt+F11），点击「工具」-「引用」，勾选对应版本的Microsoft Word [你的Office版本号] Object Library
• 如果仍有偶发粘贴报错，可以把顶部WAIT_TIME常量的数值适当调高到0.3~0.5秒

内容的提问来源于stack exchange，提问作者mwnm