как сделать цикл для скрипта Word

Question

как сделать цикл для скрипта Word

rhgarfhg Знаток (352), на голосовании 5 лет назад

Имеется следующий скрип в Word, который сохраняет результаты слияния Word и EXCEL по отдельным документам с присвоением имени файлу из определенной ячейки EXCEL. На выходе необходимо получить порядка 300 файлов, 300 раз копировать код скрипта довольно муторно, подскажите как его зациклить, что бы цикл повторялся например 300 раз и автоматически в каждом цикле увеличивал значения Range("A1"), .FirstRecord = 1 и .LastRecord = 1 от 1 до 300

Sub Макрос2()
'
' Макрос2 Макрос
With ActiveDocument.MailMerge

Dim objExcel, objWorkbook
Dim strName As String

' On Error GoTo errExcel
Set objExcel = CreateObject("Excel.Application")
'objExcel.Visible = True
Set objWorkbook = objExcel.Workbooks.Open("C:\Users\Alex\Desktop\каталоги \шаблон\название файлов для сохранения 4сп. xlsx") 'указываем путь для файла Excel в котором содержатся названия сохраняемых файлов
strName = objWorkbook.Sheets("Лист1").Range("A1").Text 'указываем лист и ячейку в которых содержатся название сохраняемого файла
objExcel.Quit

.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
'задаем № документа слияния
.FirstRecord = 1
.LastRecord = 1
End With
.Execute Pause:=False
End With
ActiveDocument.SaveAs2 FileName:=strName, FileFormat:= _
wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False, CompatibilityMode:=14
ActiveWindow.Close

Answer 1

Навскидку - т. к. документов и шаблонов у меня нет, а код похоже чуть-чуть обрезался.
Забавно т. к. похоже, как будто если бы одну (первую) часть кода писал я =)

With ActiveDocument.MailMerge

Dim objExcel, objWorkbook, objCell
Dim strName As String
Dim i As Integer

' On Error GoTo errExcel
Set objExcel = CreateObject("Excel.Application")
'objExcel.Visible = True
Set objWorkbook = objExcel.Workbooks.Open("C:\Users\Alex\Desktop\каталоги \шаблон\название файлов для сохранения 4сп. xlsx") 'указываем путь для файла Excel в котором содержатся названия сохраняемых файлов
Set objCell = objWorkbook.Sheets("Лист1").Range("A1")

For i = 1 To 300
strName = objCell.Text

.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
'задаем № документа слияния
.FirstRecord = i
.LastRecord = i
End With
.Execute Pause:=False
End With
ActiveDocument.SaveAs2 FileName:=strName, FileFormat:= _
wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False, CompatibilityMode:=14
ActiveWindow.Close
Set objCell = objCell.Offset(1,0)
Next
objExcel.Quit

и конец когда, что у Вас не поместился судя по всему. Пишите в комменты если что.