使复制粘贴更快 excel vba 到 word

Question

我一直在组装一个代码，基本上是将粘贴数据从 excel 复制到 word 表，但有点慢。

而且我还注意到，当我将 screenupdating 和事件设为 false 时，程序会停止，没有任何错误消息。

我想得到您的建议以加快代码速度。 谢谢！

Sub InspecForm()

'PURPOSE: Copy/Paste An Excel Table Into a New Word Document
'NOTE: Must have Word Object Library Active in Order to Run _
  (VBE > Tools > References > Microsoft Word 12.0 Object Library)
'SOURCE: www.TheSpreadsheetGuru.com

Dim tbl As Excel.Range
Dim WordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table
Dim rwcll, wrdlct As Integer
Dim lRow, llRow As Long


'Optimize Code
  'Application.ScreenUpdating = False
  'Application.EnableEvents = False

'Copy Range from Excel, Set tbl = ThisWorkbook.Worksheets(Sheet1.Name).ListObjects("Table1").Range

'Create an Instance of MS Word
  On Error Resume Next

    'Is MS Word already opened?
      Set WordApp = GetObject(class:="Word.Application")

    'Clear the error between errors
      Err.Clear

    'If MS Word is not already open then open MS Word
      If WordApp Is Nothing Then Set WordApp = CreateObject(class:="Word.Application")

    'Handle if the Word Application is not found
      If Err.Number = 429 Then
        MsgBox "Microsoft Word could not be found, aborting."
        GoTo EndRoutine
      End If

  On Error GoTo 0

'Make MS Word Visible and Active
  WordApp.Visible = True
  WordApp.Activate

'Select Document
  Set myDoc = WordApp.Documents.Open(ThisWorkbook.Path & "\Generic Inspection Form.docx")

'Variables to control the copy and paste
  rwcll = 2
  wrdlct = 44
  lRow = 2
  llRow = 2

  Worksheets("Receiving List").Range("C" & 2).Copy

            myDoc.Paragraphs(3).Range.PasteExcelTable _
            LinkedToExcel:=False, _
            WordFormatting:=False, _
            RTF:=True



    Do While (Cells(lRow, 1) <> "")

    'Copy Excel Values and Paste on word
          Worksheets("D").Range("A" & rwcll).Copy

          myDoc.Paragraphs(wrdlct).Range.PasteExcelTable _
            LinkedToExcel:=False, _
            WordFormatting:=False, _
            RTF:=True
            wrdlct = wrdlct + 1

    'Copy Excel Values and Paste on word
         Worksheets("D").Range("B" & rwcll).Copy

          myDoc.Paragraphs(wrdlct).Range.PasteExcelTable _
            LinkedToExcel:=False, _
            WordFormatting:=False, _
            RTF:=True

     'Variable for positioning the paste
           rwcll = rwcll + 1
           wrdlct = wrdlct + 9
           lRow = 1 + lRow
           llRow = 1 + llRow

    'Variable for positioning the paste
           If llRow = 17 Then
           wrdlct = wrdlct + 17
           llRow = 0
           End If



    Loop

            lRow = lRow - 2
            Range("G1").Value = lRow

          Worksheets("D").Range("G" & 1).Copy

            myDoc.Paragraphs(9).Range.PasteExcelTable _
            LinkedToExcel:=False, _
            WordFormatting:=False, _
            RTF:=True
            Application.CutCopyMode = False
            wrdlct = wrdlct + 1


EndRoutine:
'Optimize Code
  Application.ScreenUpdating = True
  Application.EnableEvents = True

'Clear The Clipboard
  Application.CutCopyMode = False

End Sub

Answer 1

在页面顶部添加： Option Explicit ，这会强制您使用变量并加快速度.. 在代码末尾添加： Application.ScreenUpdating = True ，这会加快速度。