Блог

Приведенный ниже код предназначен для последовательного копирования строки из ячеек в столбце Excel (i = 3-61), поиска папки каталога, содержащей множество копий одного и того же файла .doc, и вставки каждой строки во вторую строку, первый столбец первой таблицы в каждом файле .doc.

Проблема: программа намеренно продолжает цикл и завершает выполнение остальной части кода после первого выполнения следующей строки:

 wddoc.Tables(1).Cell(2, 1).Range.Paste
  

Это происходит даже при том, что я перехожу в каждую строку кода, используя F8, чтобы добраться до этой строки кода. Код завершает выполнение, ничего не вставив в оставшиеся файлы в каталоге. (Строка в строке 3 документа Excel была успешно вставлена в plan template — Copy (10).docx, но остальные строки не были вставлены в остальные файлы)

Код:

 Option Explicit
Sub CopyExcelToWord(path As String)

'variables----------------------------------------------------------------

'Decare Object variables for the Word application and file or documentl
Dim wdapp As Object, wddoc As Object, i As Integer

'Declare a String variable for the directory root and current file in that directory
Dim currentPath As String


'main process----------------------------------------------------------

'error handling is extremely important in making Excel work with Word
On Error Resume Next
'GetObject needs two parameters. The first is optional
Set wdapp = GetObject(, "Word.Application")
If Err.Number = 429 Then
Err.Clear
'we create a new instance of MS Word
Set wdapp = CreateObject("Word.Application")
End If

'Our application is made visible

wdapp.Visible = True

currentPath = Dir(path, vbDirectory)

For i = 3 To 61
Do Until currentPath = vbNullString
Debug.Print currentPath



        If Left(currentPath, 1) <> "." And Left(currentPath, 1) <> "" Then
        Debug.Print path amp; currentPath
           
            Sheet1.Range(Cells(i, 2), Cells(i, 2)).Copy
            'we activate our MS Word instance
            wdapp.Activate
            Set wddoc = wdapp.Documents(path amp; currentPath)
            If wddoc Is Nothing Then Set wddoc = wdapp.Documents.Open(path amp; currentPath)
            wddoc.Activate
            wddoc.Tables(1).Cell(2, 1).Range.Paste
            'Free alocated memory and close
            wdapp.Quit
            Set wddoc = Nothing
            Set wdapp = Nothing
        'The following line of code removes the cell selection in Excel
        Application.CutCopyMode = False
        currentPath = Dir()
        Else
        
        currentPath = Dir()
        
        End If


           
Loop


Next
End Sub
  

Печать (я поместил «…«, где я пропустил часть пути):

. . . . plan template — Copy (10).docx L C:**…** plan template — Copy (10).docx

Программа непреднамеренно выполняет остальную часть кода. Строка в строке 3 документа Excel была успешно вставлена в шаблон плана — Копировать (10).docx, а остальные строки не были вставлены в остальные файлы)

копия шаблона плана (11).docx L C: *…**шаблон плана — Копировать (11).docx Шаблон плана урока — Копировать (12).docx L C: * … шаблон плана -копировать (12).docx шаблон плана — копировать (13).docx LC: ** … plan template — L … C: *…** plan template — Копировать (9).план урока docx template.docx L C:*…**план template.docx

Я не уверен, что исправление этого решит вашу проблему, но у вас есть

         wddoc.Tables(1).Cell(2, 1).Range.Paste
        'Free alocated memory and close
        wdapp.Quit
        Set wddoc = Nothing
        Set wdapp = Nothing
  

После того, как вы выполнили wdapp.Quit, у вас больше нет wdapp, поэтому на следующей итерации вашего цикла «For i» ничего не будет работать.

Но если вы хотите сохранить свой wddoc, вы не можете полагаться на Set wddoc = Nothing это. Вам нужно выполнить явное закрытие или сохранить и закрыть

Так, например

         wddoc.Tables(1).Cell(2, 1).Range.Paste
        wddoc.Close -1 ' SaveChanges:=Word.wdSaveOptions.wdSaveChanges
        ' Only do this outside your "For i =" loop
        'Free alocated memory and close
        'wdapp.Quit
        Set wddoc = Nothing
        ' Only do this outside your "For i =" loop
        ' Set wdapp = Nothing
  

Ваша «проблема» не имеет ничего общего с командой paste .

Ваш код устанавливает, что все ошибки должны игнорироваться, создает объект приложения Word, затем входит в цикл, где:

1. значение ячейки копируется
2. открывается документ Word
3. содержимое буфера обмена вставляется в ячейку таблицы в документе Word
4. Word закрывается, а объект приложения уничтожается

Первая итерация цикла будет выполнена успешно, но последующие итерации приведут к ошибке в каждой строке, которая включает Word, поскольку объект больше не существует. Эти ошибки игнорируются из-за On Error Resume Next .

Что вам нужно сделать:

1. Сброс обработки ошибок после получения объекта Word
2. Добавьте флаг, если Word не был открыт, чтобы его можно было закрыть по завершении операций
3. Закройте документ и сохраните изменения после его завершения внутри цикла
4. Перемещение wdapp.quit за пределы цикла

Поскольку Word сохраняет историю буфера обмена, и вы копируете только значение одной ячейки, я бы не стал использовать copy paste для этого. Вместо этого запишите значение непосредственно в ячейку таблицы.

Вот как я бы написал ваш код:

 Option Explicit

Sub CopyExcelToWord(path As String)

   'variables----------------------------------------------------------------

   'Decare Object variables for the Word application and file or document
   Dim wdapp As Object, wddoc As Object, i As Integer

   'Declare a String variable for the directory root and current file in that directory
   Dim currentPath As String

   'declare flag to show if Word needs to be quit
   Dim quitWord As Boolean
   
   'main process----------------------------------------------------------

   'error handling is extremely important in making Excel work with Word
   On Error Resume Next
   'GetObject needs two parameters. The first is optional
   Set wdapp = GetObject(, "Word.Application")
   If Err.Number = 429 Then
      Err.Clear
      'we create a new instance of MS Word
      Set wdapp = CreateObject("Word.Application")
      'as Word wasn't already open make application visible
      wdapp.Visible = True
      'set flag to show Word needs to be shut down
      quitWord = True
   End If

   'reset error handling so that any subsequent errors aren't ignored
   On Error GoTo 0
   
   currentPath = Dir(path, vbDirectory)

   For i = 3 To 61
      Do Until currentPath = vbNullString
         Debug.Print currentPath

         If Left(currentPath, 1) <> "." And Left(currentPath, 1) <> "" Then
            Debug.Print path amp; currentPath
           
            Set wddoc = wdapp.Documents.Open(path amp; currentPath)
            wddoc.Tables(1).Cell(2, 1).Range.Text = Sheet1.Range(Cells(i, 2), Cells(i, 2)).Value
            'document no longer required so close and save changes
            wddoc.Close -1 ' SaveChanges:=Word.wdSaveOptions.wdSaveChanges
            Set wddoc = Nothing
            
            currentPath = Dir()
         Else
        
            currentPath = Dir()
        
         End If
      Loop
   Next
   
   'Now that operations involving Word are complete quit Word if necessary and destroy objects
   If quitWord Then wdapp.Quit
   Set wdapp = Nothing
End Sub