Начиная с версии Windows 1803 обновление kb4103729 мой макрос для создания PDF и отправки счета перестал работать. Это макрос с несколькими командами в нем, который ссылается как на лист, так и на папку назначения (см. Ниже).

Я проверил все ссылки и запустил все решения, которые смог найти здесь: удаление всех файлов .exd и изменение языковых настроек для запуска кода VBA (обновление затрагивает языковые пакеты, и я использую голландскую версию excel). Я надеюсь, что кто-то может помочь мне в этом.

Кажется, проблема связана с этим макросом (затронуты все его версии, одна для кредитных нот и две для счетов на других языках, но не для других макросов). Это продолжает давать мне второе окно ошибки («Невозможно создать PDF, возможные причины:...»).

Вот макрос:

Sub Create_PDFmail() Dim FileName As String

If ActiveWindow.SelectedSheets.Count > 1 Then
    MsgBox "There is more then one sheet selected," & vbNewLine & _
           "ungroup the sheets and try the macro again"
Else

    FileName = RDB_Create_PDF(Source:=Range("A1:F39"), _
                              FixedFilePathName:="C:\Users\woute\SharePoint\CareerCoach - Admin\Boekhouding\Verkoopfacturen\CC Factuur " & ThisWorkbook.Sheets("Template").Range("Template!E11").Value & ".pdf", _
                              OverwriteIfFileExist:=True, _
                              OpenPDFAfterPublish:=False)

    'For the selection use Selection in the Source argument
    'FileName = RDB_Create_PDF(Source:=Selection)

    'For a fixed file name use this in the FixedFilePathName argument
    'FixedFilePathName:="C:\Users\Ron\Test\YourPdfFile.pdf"

    If FileName <> "" Then
        RDB_Mail_PDF_Outlook FileNamePDF:=FileName, _
                             StrTo:=ThisWorkbook.Sheets("Template").Range("Template!H2").Value, _
                             StrCC:="", _
                             StrBCC:="", _
                             StrSubject:="factuur " & ThisWorkbook.Sheets("Template").Range("Template!E11").Value, _
                             Signature:=True, _
                             Send:=False, _
                             StrBody:="<body>Beste " & Range("Template!H3").Value & ",<br><br>" & _
                                        "In bijlage vindt u de meest recente factuur voor de dienstverlening <b><i>" & Range("Template!B12").Value & ".</i></b>" & _
                                        "<br>" & "...Bunch of body text" & _
                                       </body>"

    Else
        MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
               "Microsoft Add-in is not installed" & vbNewLine & _
               "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
               "The path to Save the file in arg 2 is not correct" & vbNewLine & _
               "You didn't want to overwrite the existing PDF if it exist"
    End If
End If

End Sub

|источник

1 ответ1

1

У меня была та же проблема, и я решил ее следующим образом:

Windows+R и выполнить% COMMONPROGRAMFILES%

Затем перейдите в раздел "Microsoft Shared", найдите файл EXP_PDF.DLL в любой папке OFFICEXX и скопируйте его в папку OFFICE16.

Попробуйте свой макрос.

Если это не работает, вы все равно можете прокомментировать строки, проверяющие установку надстройки (блок First If и последний блок EndIf) в функции RDB_create_PDF, объявляют:

    Function RDB_Create_PDF(Myvar As Object, FixedFilePathName As String, _
             OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
Dim FileFormatstr As String
Dim Fname As Variant

'Test to see if the Microsoft Create/Send add-in is installed.
If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
     & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then

    If FixedFilePathName = "" Then
        'Open the GetSaveAsFilename dialog to enter a file name for the PDF file.
        FileFormatstr = "PDF Files (*.pdf), *.pdf"
        Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
              Title:="Create PDF")

        'If you cancel this dialog, exit the function.
        If Fname = False Then Exit Function
    Else
        Fname = FixedFilePathName
    End If

    'If OverwriteIfFileExist = False then test to see if the PDF
    'already exists in the folder and exit the function if it does.
    If OverwriteIfFileExist = False Then
        If Dir(Fname) <> "" Then Exit Function
    End If

    'Now export the PDF file.
    On Error Resume Next
    Myvar.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=Fname, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=OpenPDFAfterPublish
    On Error GoTo 0

    'If the export is successful, return the file name.
    If Dir(Fname) <> "" Then RDB_Create_PDF = Fname
End If
End Function

Надеюсь, это поможет, если все еще нужно.

|источник

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .