☰

Excel VBA - In einer Zelle angegebenen Bereich als PDF drucken und per Outlook senden

tag-icon • tag-icon microsoft-excel pdf vba printing
Excel VBA - In einer Zelle angegebenen Bereich als PDF drucken und per Outlook senden

Ich habe keine große Erfahrung mit Excel VBA, versuche aber, ein Makro zu erstellen, das einen Bereich angegebener Zellen als PDF druckt und über Outlook sendet.

Folgendes bekomme ich nicht zum Laufen:

  • Es wird nicht im angegebenen Ordner in Zelle N9 meines Dokuments gespeichert
  • Das PDF wird nicht unter dem in Zelle N10 angegebenen Namen gespeichert
  • Am wichtigsten ist, dass das PDF nicht in dem angegebenen Bereich gedruckt wird, den ich in Zelle N4 habe
  • Gibt es auch eine Möglichkeit, den Teil zu umgehen, in dem der Ordner angegeben werden muss, in dem die PDF gespeichert werden soll? Gehen Sie einfach direkt zur E-Mail

Hier ist dieBeispieldatei

Hier ist der Code, den ich bisher habe, ich habe keine Erfahrung mit 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

Antwort1

"Ich bin sehr unerfahren mit Excel VBA"
Da ist aber jemand bescheiden.

Ich sehe nichts, worauf ich zeigen und sagen könnte: „Das ist das Problem“, aber Ihr Code verweist ständig darauf ActiveSheetund das kann sehr gefährlich sein.

Das Problem bei ActiveSheetdieser Art des Hämmerns ist, dass Sie nicht sicher sein können, ob es das ActiveSheetist, was Sie erwarten. Ich habe 6 Aufrufe dafür gezählt, das sind 6 Möglichkeiten, dass eine beliebige Anzahl von Dingen das aktive Blatt ändert und Ihr Programm entgleisen lässt.

Wenn Sie mit dem falschen Arbeitsblatt zu arbeiten beginnen, passieren merkwürdige Dinge. Beispielsweise kann eine Datei nicht gespeichert werden, weil die falsche Zelle gelesen wurde. Oder der Ausdruck funktioniert nicht richtig, weil das Programm das UsedRangefalsche Blatt liest.

Nun, ich sage nicht, dass dies die Ursache des Problems ist, aber Ihr Code ist gut genug geschrieben, dass ich ein Problem ausschließen kann, und dieses kann ich nicht ausschließen.

verwandte Informationen