Excel VBA – Salvar Como (Imprimir) em PDF

Este tutorial demonstrará como salvar/imprimir em um PDF no Excel VBA.

Imprimir em PDF

Esse procedimento simples imprimirá o ActiveSheet em um PDF.

Sub ImpressaoSimplesEmPDF()

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="demo.pdf", Quality:=xlQualityStandard, _
  IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=True

End Sub

Também criei uma função com tratamento de erros, etc., que imprimirá o ActiveSheet em um PDF:

Sub Imprimr_PDF()
    Call Salvar_PDF
End Sub


Function Salvar_PDF() As Boolean  ' Copia planilhas em um novo arquivo PDF para envio por e-mail
    Dim Thissheet As String, ThisFile As String, PathName As String
    Dim SvAs As String

Application.ScreenUpdating = False

' Obter nome para salvar o arquivo
    Thissheet = ActiveSheet.Name
    ThisFile = ActiveWorkbook.Name
    PathName = ActiveWorkbook.Path
    SvAs = PathName & "\" & Thissheet & ".pdf"

'Definir qualidade de impressão
    On Error Resume Next
    ActiveSheet.PageSetup.PrintQuality = 600
    Err.Clear
    On Error GoTo 0

' Instruir o usuário sobre como enviar
    On Error GoTo RefLibError
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=SvAs, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=True
    On Error GoTo 0
    
SaveOnly:
    MsgBox "Uma cópia desta planilha foi salva com sucesso como um arquivo .pdf: " & vbCrLf & vbCrLf & SvAs & _
        "Revise o documento .pdf. Se o documento NÃO estiver com boa aparência, ajuste os parâmetros de impressão e tente novamente."
        
    Salvar_PDF = True
    GoTo EndMacro
    
RefLibError:
    MsgBox "Não foi possível salvar como PDF. Biblioteca de referência não encontrada."
    Salvar_PDF = False
EndMacro:
End Function

A função retorna TRUE ou FALSE se a impressão em PDF foi bem-sucedida ou não.

Função Salvar e Enviar PDF por e-mail

Essa função salvará o ActiveSheet como PDF e (opcionalmente) anexará o PDF a um e-mail (supondo que você tenha o Outlook instalado):

Sub Teste_Salvar_PDF()
    Call Enviar_PDF("SendEmail")
End Sub


Function Enviar_PDF(Optional action As String = "SaveOnly") As Boolean  ' Copia planilhas em um novo arquivo PDF para envio por e-mail
    Dim Thissheet As String, ThisFile As String, PathName As String
    Dim SvAs As String

Application.ScreenUpdating = False

' Obter nome para salvar o arquivo
    Thissheet = ActiveSheet.Name
    ThisFile = ActiveWorkbook.Name
    PathName = ActiveWorkbook.Path
    SvAs = PathName & "\" & Thissheet & ".pdf"

'Definir qualidade de impressão
    On Error Resume Next
    ActiveSheet.PageSetup.PrintQuality = 600
    Err.Clear
    On Error GoTo 0

' Instruir o usuário sobre como enviar
    On Error GoTo RefLibError
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=SvAs, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=True
    On Error GoTo 0
    
' Enviar e-mail
    If action = "SendEmail" Then
        On Error GoTo SaveOnly
        Set olApp = CreateObject("Outlook.Application")
        Set olEmail = olApp.CreateItem(olMailItem)
        
        With olEmail
            .Subject = Thissheet & ".pdf"
            .Attachments.Add SvAs
            .Display
        End With
        On Error GoTo 0
        GoTo EndMacro
    End If
    
SaveOnly:
    MsgBox "Uma cópia desta planilha foi salva com sucesso como um arquivo .pdf: " & vbCrLf & vbCrLf & SvAs & _
        "Revise o documento .pdf. Se o documento NÃO estiver com boa aparência, ajuste os parâmetros de impressão e tente novamente."
        
    Enviar_PDF = True
    GoTo EndMacro
    
RefLibError:
    MsgBox "Não foi possível salvar como PDF. Biblioteca de referência não encontrada."
    Enviar_PDF = False
EndMacro:
End Function