Генерация PDF из Exсel и шаблона Word

[DENGA-RU]

Добрый день!

Как то понадобилось создание текстовых файлов из списка екселевского файла и шаблона Word. На данном форуме был опубликован пример генерации договоров из екселевского файла и вордовского шаблона. Но так как нужно было сделать, чтобы помимо документов Doc, также шло создание файла PDF, я добавил часть кода взятого из макрорекодера, но почему то возникает ошибка.

добавленные строки кода:
Const РасширениеСоздаваемыхФайловПДФ = ".pdf" 'добавлено
FilenamePDF = НоваяПапка & Имяфайла & РасширениеСоздаваемыхФайловПДФ 'добавлено
WD.ExportAsFixedFormat , OutputFileName:=FilenamePDF, ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False ' ошибка

P.S. на форме пытался найти ответ, но похожей ситуации не нашел

[Desc]

Обновите версию microsoft office до 2007 или более поздней версии, и получите возможность сохранять файлы в формате pdf.

[Aleksandr H.]

filenamePDF = НоваяПапка & Имяфайла & РасширениеСоздаваемыхФайловПДФ 'добавлено

Имяфайла где формируется?

[DENGA-RU]

Сообщение от Desc

Обновите версию microsoft office до 2007 или более поздней версии, и получите возможность сохранять файлы в формате pdf.

у меня microsoft office 2007 стоит на компе, в принципе я так и делаю, вопрос в другом, что у меня десятки файлов надо сохранить в PDF, поэтому вот решил как то автоматизировать процесс

[DENGA-RU]

Сообщение от Aleksandr H.

filenamePDF = НоваяПапка & Имяфайла & РасширениеСоздаваемыхФайловПДФ 'добавлено

Имяфайла где формируется?

Const ИмяФайлаШаблона = "шаблон.dot"
Const КоличествоОбрабатываемыхСтолбцов = 8
Const РасширениеСоздаваемыхФайлов = ".doc"
Const РасширениеСоздаваемыхФайловПДФ = ".pdf" 'добавлено

Sub СформироватьДоговоры()
    ПутьШаблона = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, ИмяФайлаШаблона)
    НоваяПапка = NewFolderName & Application.PathSeparator
    Dim row As Range, pi As New ProgressIndicator
    r = Cells(Rows.Count, "A").End(xlUp).row: rc = r - 2
    If rc < 1 Then MsgBox "Строк для обработки не найдено", vbCritical: Exit Sub

    Dim WA As Object, WD As Object ': Set WA = New Word.Application    ' c подключением библиотеки Word
    Set WA = CreateObject("Word.Application")    ' без подключения библиотеки Word - почему-то замена не производится
    For Each row In ActiveSheet.Rows("3:" & r)
        With row
            ФИО = Trim$(.Cells(1)) & " " & Trim$(.Cells(2)) & " " & Trim$(.Cells(3))
            Filename = НоваяПапка & ФИО & РасширениеСоздаваемыхФайлов
            FilenamePDF = НоваяПапка & Имяфайла & РасширениеСоздаваемыхФайловПДФ 'добавлено

            Set WD = WA.Documents.Add(ПутьШаблона): DoEvents

            For i = 1 To КоличествоОбрабатываемыхСтолбцов
                FindText = Cells(1, i): ReplaceText = Trim$(.Cells(i))
                FindText = Replace(FindText, " ", "")
                FindText = Replace(FindText, "{", "")
                FindText = Replace(FindText, "}", "")
                UpdateBookmarks WD, FindText, ReplaceText
    
                DoEvents
            Next i
            WD.Fields.Update 'Обновляем поля в документе
            'возникает ошибка
            WD.ExportAsFixedFormat , OutputFileName:=FilenamePDF, ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False ' ошибка
            
            WD.SaveAs Filename, AddToRecentFiles:=False: WD.Close False: DoEvents
           
        End With
    Next row

    WA.Quit False

End Sub

'Процедура обновления закладок в документе
Sub UpdateBookmarks(ByVal Doc As Object, ByVal NameOfBookmark As String, ByVal ContentOfBookmark As Variant)
    On Error Resume Next
    Dim rng As Object
    Dim bm As Object
    Set bm = Doc.Bookmarks
    Set rng = bm(NameOfBookmark).Range
    rng.Text = ContentOfBookmark
    bm.Add NameOfBookmark, rng
End Sub

Function NewFolderName() As String
    NewFolderName = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "Договоры, сформированные " & Get_Now)
    MkDir NewFolderName
End Function

Function Get_Date() As String: Get_Date = Replace(Replace(DateValue(Now), "/", "-"), ".", "-"): End Function
Function Get_Time() As String: Get_Time = Replace(TimeValue(Now), ":", "-"): End Function
Function Get_Now() As String: Get_Now = Get_Date & " в " & Get_Time: End Function

по сути это программа СуперМодератора EducatedFool, я просто пытаюсь впихнуть в неё возможность создания pdf

[Aleksandr H.]

Замените имяфайла на фио.


Не спрашивалось где взяли код, это не важно. Вопрос в том разобрались ли что каждая команда делает

[DENGA-RU]

Сообщение от Aleksandr H.

Замените имяфайла на фио.


Не спрашивалось где взяли код, это не важно. Вопрос в том разобрались ли что каждая команда делает

Все сделал, но код ошибки остался неизменным:

"Run-time error '448'
Named argument not found"

[IgorGO]

а какую роль здесь
WD.ExportAsFixedFormat , OutputFileName:=FilenamePDF, ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False ' ошибка
выполняет первая запятая (зачем она там?)

[DENGA-RU]

Сообщение от IgorGO

а какую роль здесь
WD.ExportAsFixedFormat , OutputFileName:=FilenamePDF, ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False ' ошибка
выполняет первая запятая (зачем она там?)

"," оказалась маленькой ошибкой, после того как её убрал код ошибки изменился и стал:
"Run-time error '5'
Invalid procedure call or argument"

P.S. Все таки наверно основная ошибка это "WD.ExportAsFixedFormat"

[Aleksandr H.]

P.S. Все таки наверно основная ошибка это "WD.ExportAsFixedFormat"

и все таки основная ошибка - нежелание гуглить

Надеюсь ваш код такой вид имеет?

FilenamePDF = НоваяПапка & ФИО & РасширениеСоздаваемыхФайловПДФ 'добавлено
WD.ExportAsFixedFormat OutputFileName:=FilenamePDF, ExportFormat:=17