A macro do Excel parou de funcionar após a atualização do Windows kb4103729

0

Desde que a versão 1803 do Windows atualizou o kb4103729, minha macro para gerar um pdf e enviar uma fatura parou de funcionar. É uma macro com vários comandos e referências à planilha e à pasta de destino (veja abaixo).

Eu verifiquei todas as referências e executei todas as soluções que pude encontrar aqui: excluindo todos os arquivos .exd e alterando as configurações de idioma para executar o código VBA (a atualização afeta os pacotes de idiomas e estou executando uma versão holandesa de excel). Espero que alguém possa me ajudar nessa.

O problema parece ser específico para essa macro (todas as versões que tenho dela, uma para notas de crédito e duas para faturas em outros idiomas, são afetadas, mas não as outras macros). Ele continua me dando a segunda caixa de erro ("Não é possível criar o PDF, possíveis razões: ...").

Aqui está a macro:

Sub Create_PDFmail ()     Dim FileName como seqüência de caracteres

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

    
por WouterVB 05.06.2018 / 00:49

1 resposta

1

Eu tive o mesmo problema e resolvi o seguinte:

Windows + R e execute% COMMONPROGRAMFILES%

Em seguida, vá para "Microsoft Shared", agora localize o EXP_PDF.DLL na pasta OFFICEXX e copie-o para a pasta OFFICE16.

Experimente a sua macro.

Se não estiver funcionando, você ainda pode comentar as linhas testando a instalação do suplemento (First If block e last EndIf block) na função RDB_create_PDF declarar:

    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

Espero que isso ajude, se ainda for necessário.

    
por 10.09.2018 / 15:43