☰

Excel VBA - Imprimir intervalo especificado em uma célula para PDF e enviar pelo Outlook

tag-icon • tag-icon microsoft-excel pdf vba printing
Excel VBA - Imprimir intervalo especificado em uma célula para PDF e enviar pelo Outlook

Sou muito inexperiente com Excel VBA mas estou tentando criar uma macro que imprima em PDF um intervalo de células especificadas e envie pelo Outlook.

Não estou conseguindo trabalhar o seguinte:

  • Não está salvando na pasta especificada na célula N9 do meu documento
  • Não está salvando o PDF com o nome especificado na célula N10
  • Mais importante ainda, não está imprimindo o PDF no intervalo especificado que tenho na célula N4
  • Além disso, existe uma maneira de ignorar a parte de especificar a pasta onde salvar o PDF. Basta ir direto para o e-mail

Aqui está oarquivo de exemplo

Aqui está o código que tenho até agora, não tenho experiência em VBA

Sub Saveaspdfandsend()
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range

Set xSht = ActiveSheet
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

If xFileDlg.Show = True Then
   xFolder = xFileDlg.SelectedItems(1)
Else
   MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
   Exit Sub
End If
xFolder = ActiveSheet.Range("n9")
xFolder = xFolder + "\" + xSht.Name + ".pdf"

'Check if file already exist
If Len(Dir(xFolder)) > 0 Then
    xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
                      vbYesNo + vbQuestion, "File Exists")
    On Error Resume Next
    If xYesorNo = vbYes Then
        Kill xFolder
    Else
        MsgBox "if you don't overwrite the existing PDF, I can't continue." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
        Exit Sub
    End If
    If Err.Number <> 0 Then
        MsgBox "Unable to delete existing file.  Please make sure the file is not open or write protected." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
        Exit Sub
    End If
End If

Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
    'Save as PDF file
    xSht.ExportAsFixedFormat Type:=xlTypePDF, FileName:=xFolder, Quality:=xlQualityStandard

    'Create Outlook email
    Set xOutlookObj = CreateObject("Outlook.Application")
    Set xEmailObj = xOutlookObj.CreateItem(0)
    With xEmailObj
        .Display
        .To = ActiveSheet.Range("n5")
        .CC = ActiveSheet.Range("n6")
        .Subject = ActiveSheet.Range("n7")
        .HTMLBody = "<font face=" & Chr(34) & "Calibri" & Chr(34) & " size=" & Chr(34) & 4 & Chr(34) & ">" & "Good day dear Master," & "<br> <br>" & ActiveSheet.Range("n8") & "<br> <br>" & Signature & "</font>"
        .Attachments.Add xFolder
        If DisplayEmail = False Then
            '.Send
        End If
    End With
Else
  MsgBox "The active worksheet cannot be blank"
  Exit Sub
End If
End Sub

Responder1

"Sou muito inexperiente com Excel VBA"
Alguém está sendo modesto.

Não vejo nada que possa apontar e dizer: “esse é o problema”; mas seu código está constantemente se referindo a ActiveSheete isso pode ser algo muito perigoso.

O problema de martelar ActiveSheetassim é que você não pode ter certeza de que ActiveSheeté o que espera que seja. Contei 6 ligações para isso, são 6 oportunidades para uma série de coisas alterarem a planilha ativa e inviabilizarem seu programa.

Coisas estranhas acontecem quando você começa a trabalhar com a planilha errada. Coisas como não conseguir salvar um arquivo porque ele leu a célula errada. Ou não imprime corretamente porque o programa está lendo a UsedRangeplanilha errada.

Bem, não estou dizendo que é isso que está causando o problema, mas seu código está escrito bem o suficiente para que eu possa descartar problemas, e não posso descartar este.

informação relacionada