2015-11-25 3 views
2

Я собираю код, который в основном копирует данные пасты из Excel в текстовую таблицу, но немного медленнее.make copy paste fast excel vba to word

И я также заметил, что, когда я делаю ложные всплывающие окна и события, программы останавливаются, без какого-либо сообщения об ошибке.

Я хотел бы получить рекомендации по ускорению кода. Благодаря!

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 
+0

Удалить комментарии в '' Application.ScreenUpdating = False' и ''Application.EnableEvents = False'. Это должно сделать это немного быстрее – phil652

+0

Вы используете 'On Error Resume Next' - почему вы ожидаете сообщения об ошибке? –

+0

@MacroMan Это ловушка ошибки, если Word еще не запущен. –

ответ

1

В верхней части страницы добавить: Option Explicit, который заставляет вас использовать переменные и ускоряет его .. В конце кода добавить: Application.ScreenUpdating = True, что ускоряет его.