從 excel 復制到 word doc 時 VBA 代碼崩潰：錯誤 4605

Question

我有一份包含學生論文分數的 excel 文檔。

有一個摘要選項卡，可將分數整理成對學生更有用的格式。

我拼湊了一些 VBA 代碼，該代碼打開一個 word 文檔，然后逐步瀏覽每個學生記錄，復制 output 頁面並將其放入 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始終指向正確的 object 或范圍是混亂且難以跟蹤的。 它也容易出錯，因為某些東西可能會在執行過程中被用戶或方法無意中選擇。

要舉例說明如何刪除.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以保存對“Physics”和“Trilogy Output”表的引用。 這可以讓我們在不選擇它們的情況下從這些工作表中獲取范圍。
• 創建了一個 Range Object， CurrentCell以跟蹤正在復制的“物理”表中的范圍。 聲明范圍允許我們最小化寫入常量“A12”的次數。 如果以后需要編輯，這可以簡化事情。
• NumRows和x從 Integer 更改為 Long，因為 Excel 行號有可能導致整數溢出錯誤。
• 使用Range.Copy的Destination參數允許我們在同一 Excel 應用程序中的工作表之間復制時跳過使用剪貼板。 這比使用剪貼板快得多，而且更可靠，因為我們消除了對Selection的依賴。
• DoEvents是在.Copy之后添加的。 @TimothyRylatt 提到這可以幫助解決剪貼板需要時間來完成處理的問題。
• .Cells(2)與.Offset(1,0)相同，用於將單元格向下移動 1。但是我遇到了Offset的問題，並且希望盡可能避免使用它。