Wie speichere ich ein Arbeitsblatt als PDF-Datei und sende es als Anhang per E-Mail über Outlook?

In einigen Fällen müssen Sie möglicherweise ein Arbeitsblatt als PDF-Datei über Outlook senden. Normalerweise müssen Sie das Arbeitsblatt manuell als PDF-Datei speichern, dann eine neue E-Mail mit dieser PDF-Datei als Anhang in Ihrem Outlook erstellen und schließlich senden. Es ist zeitaufwändig, dies Schritt für Schritt manuell zu erreichen. In diesem Artikel zeigen wir Ihnen, wie Sie ein Arbeitsblatt schnell als PDF-Datei speichern und automatisch als Anhang über Outlook in Excel senden können.

Speichern Sie ein Arbeitsblatt als PDF-Datei und senden Sie es als Anhang mit VBA-Code per E-Mail

Speichern Sie ein Arbeitsblatt als PDF-Datei und senden Sie es als Anhang mit VBA-Code per E-Mail

Tolle! Verwenden effizienter Registerkarten in Excel wie Chrome, Firefox und Safari!

Sparen Sie 50% Ihrer Zeit und reduzieren Sie jeden Tag Tausende von Mausklicks für Sie!

Sie können den folgenden VBA-Code ausführen, um das aktive Arbeitsblatt automatisch als PDF-Datei zu speichern und es dann als Anhang über Outlook per E-Mail zu versenden. Bitte gehen Sie wie folgt vor.

1. Öffnen Sie das Arbeitsblatt, das Sie als PDF speichern und senden möchten, und drücken Sie die Taste Andere + F11 Tasten gleichzeitig zum Öffnen der Microsoft Visual Basic für Applikationen Fenster.

2. In dem Microsoft Visual Basic für Applikationen Klicken Sie im Fenster Insert > Modul. Kopieren Sie dann den folgenden VBA-Code und fügen Sie ihn in das ein Kode Fenster. Siehe Screenshot:

VBA-Code: Speichern Sie ein Arbeitsblatt als PDF-Datei und senden Sie es als Anhang per E-Mail

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 = 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 = ""
        .CC = ""
        .Subject = xSht.Name + ".pdf"
        .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

3. Drücken Sie die Taste F5 Schlüssel zum Ausführen des Codes. In dem Entdecken Wählen Sie im Dialogfeld einen Ordner aus, um diese PDF-Datei zu speichern, und klicken Sie dann auf OK .

Anmerkungen:

1. Jetzt wird das aktive Arbeitsblatt als PDF-Datei gespeichert. Und die PDF-Datei wird mit dem Arbeitsblattnamen benannt.

2. Wenn das aktive Arbeitsblatt leer ist, wird nach dem Klicken auf das Dialogfeld angezeigt (siehe Abbildung unten) OK .

4. Jetzt wird eine neue Outlook-E-Mail erstellt und Sie können sehen, dass die PDF-Datei als Anhang in der angehängten Datei aufgeführt ist. Siehe Screenshot:

5. Bitte verfassen Sie diese E-Mail und senden Sie sie dann.

6. Dieser Code ist nur verfügbar, wenn Sie Outlook als E-Mail-Programm verwenden.

Das Arbeitsmappe teilen Nutzen von Kutools for Excel kann Ihnen helfen, ein Arbeitsblatt oder mehrere Arbeitsblätter einfach als separate PDF-Dateien gleichzeitig zu speichern, wie in der folgenden Demo gezeigt. Jetzt herunterladen und ausprobieren! (30-Tag kostenlose Loipe)

In Verbindung stehende Artikel:

Die besten Tools für die Office-Produktivität

Kutools for Excel löst die meisten Ihrer Probleme und erhöht Ihre Produktivität um 80%

Wiederverwendung: Schnell einfügen komplexe Formeln, Diagramme und alles, was du vorher benutzt hast; Zellen verschlüsseln mit Passwort; Mailingliste erstellen und E-Mails senden ...
Super Formelriegel (leicht mehrere Textzeilen und Formeln bearbeiten); Layout lesen (leichtes Lesen und Bearbeiten einer großen Anzahl von Zellen); In gefilterten Bereich einfügen...
Zellen / Zeilen / Spalten zusammenführen ohne Daten zu verlieren; Inhalt geteilter Zellen; Kombinieren Sie doppelte Zeilen / Spalten... doppelte Zellen verhindern; Bereiche vergleichen...
Wählen Sie Duplizieren oder Eindeutig Reihen; Wählen Sie Leere Zeilen (alle Zellen sind leer); Super Find und Fuzzy Find in vielen Arbeitsmappen; Zufällige Auswahl ...
Exakte Kopie Mehrere Zellen ohne Änderung der Formelreferenz; Referenzen automatisch erstellen zu mehreren Blättern; Aufzählungszeichen einfügen, Kontrollkästchen und mehr ...
Text extrahieren, Text hinzufügen, Nach Position entfernen, Leerzeichen entfernen;; Paging-Zwischensummen erstellen und drucken; Inhalt und Kommentare zwischen Zellen konvertieren...
Superfilter (Speichern und Anwenden von Filterschemata auf andere Blätter); Erweiterte Sortierung nach Monat / Woche / Tag, Häufigkeit und mehr; Spezialfilter fett, kursiv ...
Kombinieren Sie Arbeitsmappen und Arbeitsblätter;; Tabellen basierend auf Schlüsselspalten zusammenführen; Daten in mehrere Blätter aufteilen; Batch-Konvertierung von xls, xlsx und PDF...
Mehr als 300 leistungsstarke Funktionen. Unterstützt Office / Excel 2007-2021 und 365. Unterstützt alle Sprachen. Einfache Bereitstellung in Ihrem Unternehmen oder Ihrer Organisation. 30-tägige kostenlose Testversion mit allen Funktionen. 60 Tage Geld-zurück-Garantie.

Lesen Sie mehr... Kostenfreier Download... Kauf...

Office Tab Bringt die Oberfläche mit Registerkarten in Office und erleichtert Ihnen die Arbeit erheblich

Aktivieren Sie das Bearbeiten und Lesen von Registerkarten in Word, Excel und PowerPoint, Publisher, Access, Visio und Project.
Öffnen und erstellen Sie mehrere Dokumente in neuen Registerkarten desselben Fensters und nicht in neuen Fenstern.
Steigert Ihre Produktivität um 50 % und reduziert jeden Tag Hunderte von Mausklicks für Sie!

Lesen Sie mehr... Kostenfreier Download... Kauf...

Kommentare (63)

Bewertet 5 aus 5 · 1 Bewertungen

Michael

vor etwa 5 Jahren

#20277

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Das funktioniert hervorragend für mich, aber gibt es eine Möglichkeit, einen Ordner automatisch auszuwählen, anstatt ihn manuell auszuwählen? Ich hoffe, dies für 40 Blätter auf einmal zu tun.

antworten

Hugh Michael

vor etwa 2 Jahren

#20278

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Ich hoffe auch auf eine Antwort auf dieses Problem! Danke für die Hilfe!

antworten

Darren

vor etwa 5 Jahren

#22279

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Ich habe versucht, dies in ein neues Modul einzufügen, und ich erhalte einen Kompilierungsfehler: Unter oder Funktion nicht definiert. Bitte helfen Sie.

antworten

Kristall Darren

vor etwa 5 Jahren

#22280

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Liebe Darren,
Welche Office-Version verwendest du?

antworten

Report

Nakia Kristall

vor etwa 4 Jahren

#22281

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Office 360

antworten

Rechnung Darren

vor etwa 3 Jahren

#22282

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Gleicher Fehler

antworten

Michael Charly

vor etwa 4 Jahren

#24346

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Wie würde ich das obige VBA-Skript so bearbeiten, dass es dem Dateinamen einen Datums- und Zeitstempel hinzufügt, damit es nicht ständig überschreibt, was bereits gespeichert ist?

antworten

Report

Kristall Michael Charly

vor etwa 4 Jahren

#24347

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Lieber Michael,
Bitte führen Sie den folgenden VBA-Code aus, um das Problem zu lösen.

Sub Als PDF speichern und senden ()
Dim xSht als Arbeitsblatt
Dim xFileDlg As FileDialog
Dim xFolder als String
Dim xYesorNo als ganze Zahl
Dim xOutlookObj als Objekt
Dim xEmailObj als Objekt
Dim xUsedRng As Range
Dim xStr als Zeichenfolge

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

Wenn xFileDlg.Show = True, dann
xFolder = xFileDlg.SelectedItems(1)
sonst
MsgBox "Sie müssen einen Ordner angeben, in dem das PDF gespeichert werden soll." & vbCrLf & vbCrLf & "Drücken Sie OK, um dieses Makro zu beenden.", vbCritical, "Zielordner muss angegeben werden"
Exit Sub
End If
xStr = Format(Now(), "yyyy-mm-dd-hh-mm-ss")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'Überprüfen Sie, ob die Datei bereits existiert
Wenn Len(Dir(xFolder)) > 0 dann
xYesorNo = MsgBox(xFolder & " bereits vorhanden." & vbCrLf & vbCrLf & "Möchten Sie es überschreiben?", _
vbYesNo + vbQuestion, "Datei existiert")
On Error Resume Next
Wenn xJaoderNein = vbJa Dann
xFolder töten
sonst
MsgBox "Wenn Sie das vorhandene PDF nicht überschreiben, kann ich nicht fortfahren." _
& vbCrLf & vbCrLf & "Drücken Sie OK, um dieses Makro zu beenden.", vbCritical, "Makro wird beendet"
Exit Sub
End If
Wenn Err.Number <> 0 Then
MsgBox "Vorhandene Datei kann nicht gelöscht werden. Bitte stellen Sie sicher, dass die Datei nicht geöffnet oder schreibgeschützt ist." _
& vbCrLf & vbCrLf & "Drücken Sie OK, um dieses Makro zu beenden.", vbCritical, "Datei kann nicht gelöscht werden"
Exit Sub
End If
End If

Legen Sie xUsedRng = xSht.UsedRange fest
Wenn Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
'Als PDF-Datei speichern
xSht.ExportAsFixedFormat Typ:=xlTypePDF, Dateiname:=xFolder, Qualität:=xlQualityStandard

„Outlook-E-Mail erstellen
Setze xOutlookObj = CreateObject("Outlook.Application")
Setze xEmailObj = xOutlookObj.CreateItem(0)
Mit xEmailObj
.Anzeige
.An = ""
.CC = ""
.Betreff = xSht.Name + "-" + xStr + ".pdf"
.Anlagen.xFolder hinzufügen
Wenn DisplayEmail = False, dann
'.Schicken
End If
Ende mit
sonst
MsgBox "Das aktive Arbeitsblatt darf nicht leer sein"
Exit Sub
End If
End Sub

antworten

Report

Parag Somani Kristall

vor etwa 3 Jahren

#24348

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Hallo Kristall,

Es ist wirklich toll und funktioniert perfekt für mich. Benötigen Sie weitere Hilfe zum Hinzufügen:

1. In "An" möchte ich einen Link zu einer bestimmten Zelle des aktiven Blatts geben, ebenso wie in CC und in BCC möchte ich einen aktiven Blattlink hinzufügen
2. Im E-Mail-Text muss ich einen Standardtext angeben.

Ich werde Ihnen für Ihre Hilfe sehr dankbar sein.

Vielen Dank
Parag

antworten

Kristall Parag Somani

vor etwa 3 Jahren

#24349

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Hallo ParagSomani,
Der folgende VBA-Code kann Ihnen helfen. Bitte ändern Sie die Felder .To, .CC, .BCC und .Body entsprechend Ihren Anforderungen.

Sub Als PDF speichern und senden ()
Dim xSht als Arbeitsblatt
Dim xFileDlg As FileDialog
Dim xFolder als String
Dim xYesorNo als ganze Zahl
Dim xOutlookObj als Objekt
Dim xEmailObj als Objekt
Dim xUsedRng As Range
Dim xStr als Zeichenfolge

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

Wenn xFileDlg.Show = True, dann
xFolder = xFileDlg.SelectedItems(1)
sonst
MsgBox "Sie müssen einen Ordner angeben, in dem das PDF gespeichert werden soll." & vbCrLf & vbCrLf & "Drücken Sie OK, um dieses Makro zu beenden.", vbCritical, "Zielordner muss angegeben werden"
Exit Sub
End If
xStr = Format(Now(), "yyyy-mm-dd-hh-mm-ss")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'Überprüfen Sie, ob die Datei bereits existiert
Wenn Len(Dir(xFolder)) > 0 dann
xYesorNo = MsgBox(xFolder & " bereits vorhanden." & vbCrLf & vbCrLf & "Möchten Sie es überschreiben?", _
vbYesNo + vbQuestion, "Datei existiert")
On Error Resume Next
Wenn xJaoderNein = vbJa Dann
xFolder töten
sonst
MsgBox "Wenn Sie das vorhandene PDF nicht überschreiben, kann ich nicht fortfahren." _
& vbCrLf & vbCrLf & "Drücken Sie OK, um dieses Makro zu beenden.", vbCritical, "Makro wird beendet"
Exit Sub
End If
Wenn Err.Number <> 0 Then
MsgBox "Vorhandene Datei kann nicht gelöscht werden. Bitte stellen Sie sicher, dass die Datei nicht geöffnet oder schreibgeschützt ist." _
& vbCrLf & vbCrLf & "Drücken Sie OK, um dieses Makro zu beenden.", vbCritical, "Datei kann nicht gelöscht werden"
Exit Sub
End If
End If

Legen Sie xUsedRng = xSht.UsedRange fest
Wenn Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
'Als PDF-Datei speichern
xSht.ExportAsFixedFormat Typ:=xlTypePDF, Dateiname:=xFolder, Qualität:=xlQualityStandard

„Outlook-E-Mail erstellen
Setze xOutlookObj = CreateObject("Outlook.Application")
Setze xEmailObj = xOutlookObj.CreateItem(0)
Mit xEmailObj
.Anzeige
.Bis = Bereich("A8")
.CC = Bereich ("A9")
.BCC = Bereich ("A10")
.Betreff = xSht.Name + "-" + xStr + ".pdf"
.Body = "Lieber" _
& vbNewLine & vbNewLine & _
„Dies ist eine Test-E-Mail“ & _
"Excel senden"
.Anlagen.xFolder hinzufügen
Wenn DisplayEmail = False, dann
'.Schicken
End If
Ende mit
sonst
MsgBox "Das aktive Arbeitsblatt darf nicht leer sein"
Exit Sub
End If
End Sub

antworten

Report

Mehul Kristall

vor ungefähr 10 Monaten

#24350

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Ich habe versucht, den Bereich für "To", "CC" zu verwenden, er nimmt einfach nicht die Werte aus der angegebenen Zelle auf. Können Sie dazu bitte weiterhelfen?
Vielen Dank,
Mehul

antworten

Parag Somani Kristall

vor etwa 3 Jahren

#24351

Dieser Kommentar wurde vom Moderator auf der Website minimiert

antworten

Parag Kristall

vor etwa 3 Jahren

#24352

Dieser Kommentar wurde vom Moderator auf der Website minimiert

antworten

Report

Armin

vor etwa 4 Jahren

#24839

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Wie kann ich zum Beispiel Blatt 2 aus der Arbeitsmappe als pdf hinzufügen?

antworten

Kristall Armin

vor etwa 4 Jahren

#24840

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Hallo Armin,
Sie müssen zuerst das Blatt 2 in Ihrer Arbeitsmappe öffnen und dann den VBA-Code mit den obigen Schritten ausführen, um es herunterzuladen.

antworten

Report

Tom H

vor etwa 4 Jahren

#25005

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Wie würde ich das obige VBA-Skript so bearbeiten, dass der Dateiname als eine bestimmte Zelle gespeichert wird, die im aktuellen Blatt ausgewählt ist, z. B. Zelle A1?

antworten

Kristall Tom H

vor etwa 4 Jahren

#25006

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Hallo Tom.
Tut mir leid, kann dabei nicht helfen.
Willkommen, um Fragen in unserem Forum zu stellen: https://www.extendoffice.com/forum.html
Weitere Excel-Unterstützung erhalten Sie von unserem Excel-Profi oder anderen Excel-Fans.

antworten

Report

Jakob

vor etwa 4 Jahren

#26183

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Hallo, wie kann ich das PDF mit dem Namen der Arbeitsmappe mit dem aktuellen VBA-Code speichern und senden? was verwende ich anstelle von xSht.Name

antworten

Kristall Jakob

vor etwa 4 Jahren

#26184

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Hallo James,
Möchten Sie das aktive Arbeitsblatt als PDF senden und es als Arbeitsmappennamen benennen?

antworten

Report

ranga

vor etwa 3 Jahren

#29450

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Danke es funktioniert.

antworten

Jason

vor etwa 3 Jahren

#29502

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Wie kann ich das gespeicherte PDF löschen, nachdem es per E-Mail gesendet wurde?

antworten

Kristall Jason

vor etwa 3 Jahren

#29503

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Hallo Jason,
Tut mir leid, da kann ich dir noch nicht helfen. Sie müssen es manuell löschen, nachdem Sie es per E-Mail gesendet haben.

antworten

Report

Odd-Inge

vor etwa 3 Jahren

#30839

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Hallo,

Ist es möglich, den Namen für PDF aus einer Zelle zu finden? Ex. Zelle H4

Und in Zelle H4 möchte ich, dass es von drei verschiedenen Zellen sammelt. Ist das möglich?

antworten

Taylor Odd-Inge

vor etwa 2 Jahren

#30840

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Das ist möglich. Erstellen Sie separate Variablen, um den Wert aus den Zellen zu speichern, und verwenden Sie diese Variablen dann beim Festlegen von xFolder.
Ich habe den Wert aus einer Zelle in meinem Blatt plus das heutige Datum verwendet. Sie könnten jedoch problemlos mehrere Zellenwerte erstellen.

Das habe ich hinzugefügt:
Dim xMemberName als Zeichenfolge
Dim xFileDate als Zeichenfolge

xMemberName = Range("H3").Wert
xFileDate = Format (jetzt "MM-TT")

xFolder = xFolder + "\" xMemberName + xFileDate + ".pdf"

antworten

Sora Taylor

vor ungefähr 4 Monaten

#40196

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Ich erhalte eine Fehlermeldung, wenn ich das versuche, wo im Code soll ich das platzieren?

antworten

Kishore

vor etwa 2 Jahren

#32506

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Hallo Kristall,

Es ist wirklich toll und funktioniert perfekt für mich. Benötigen Sie weitere Hilfe zum Hinzufügen:

1. In "Body" möchte ich einen Link zu einer bestimmten Zelle des Active Sheet geben. Außerdem möchte ich den Text fett darstellen.

Vielen Dank

Grüße

Kishore Kumar

antworten

Report

Kristall Kishore

vor etwa 2 Jahren

#32507

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Hallo,

Wollen Sie den Zellenwert automatisch zum Mailbody hinzufügen und fett darstellen? Angenommen, Sie fügen dem E-Mail-Text den Wert von C4 hinzu. Bitte wenden Sie den folgenden Code an.

Sub Als PDF speichern und senden ()

Dim xSht als Arbeitsblatt

Dim xFileDlg As FileDialog

Dim xFolder als String

Dim xYesorNo als ganze Zahl

Dim xOutlookObj als Objekt

Dim xEmailObj als Objekt

Dim xUsedRng As Range

Setzen Sie xSht = ActiveSheet

Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Wenn xFileDlg.Show = True, dann

xFolder = xFileDlg.SelectedItems(1)

sonst

MsgBox "Sie müssen einen Ordner angeben, in dem das PDF gespeichert werden soll." & vbCrLf & vbCrLf & "Drücken Sie OK, um dieses Makro zu beenden.", vbCritical, "Zielordner muss angegeben werden"

Exit Sub

End If

xFolder = xFolder + "\" + xSht.Name + ".pdf"

'Überprüfen Sie, ob die Datei bereits existiert

Wenn Len(Dir(xFolder)) > 0 dann

xYesorNo = MsgBox(xFolder & " bereits vorhanden." & vbCrLf & vbCrLf & "Möchten Sie es überschreiben?", _

vbYesNo + vbQuestion, "Datei existiert")

On Error Resume Next

Wenn xJaoderNein = vbJa Dann

xFolder töten

sonst

MsgBox "Wenn Sie das vorhandene PDF nicht überschreiben, kann ich nicht fortfahren." _

& vbCrLf & vbCrLf & "Drücken Sie OK, um dieses Makro zu beenden.", vbCritical, "Makro wird beendet"

Exit Sub

End If

Wenn Err.Number <> 0 Then

MsgBox "Vorhandene Datei kann nicht gelöscht werden. Bitte stellen Sie sicher, dass die Datei nicht geöffnet oder schreibgeschützt ist." _

& vbCrLf & vbCrLf & "Drücken Sie OK, um dieses Makro zu beenden.", vbCritical, "Datei kann nicht gelöscht werden"

Exit Sub

End If

End If

Legen Sie xUsedRng = xSht.UsedRange fest

Wenn Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then

'Als PDF-Datei speichern

xSht.ExportAsFixedFormat Typ:=xlTypePDF, Dateiname:=xFolder, Qualität:=xlQualityStandard

„Outlook-E-Mail erstellen

Setze xOutlookObj = CreateObject("Outlook.Application")

Setze xEmailObj = xOutlookObj.CreateItem(0)

Mit xEmailObj

.Anzeige

.An = ""

.CC = ""

.Betreff = xSht.Name + ".pdf"

.Anlagen.xFolder hinzufügen

.HTMLBody = "
" & Range("C4") & .HTMLBody

Wenn DisplayEmail = False, dann

'.Schicken

End If

Ende mit

sonst

MsgBox "Das aktive Arbeitsblatt darf nicht leer sein"

Exit Sub

End If

End Sub

antworten

Report

Geoff

vor etwa 2 Jahren

#33679

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Wenn ich wollte, dass es jedes Mal automatisch in einem bestimmten Ordner gespeichert wird (wodurch der Benutzer den Ordner nicht mehr auswählen muss), wie würde ich das machen?
Ex. C: Rechnungen/Nordamerika/Kunden
Hilfe wird sehr geschätzt.

antworten

Kristall Geoff

vor etwa 2 Jahren

#33680

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Hallo Geoff,
Meinen Sie damit, das Arbeitsblatt als PDF-Datei zu speichern und in einem bestimmten Ordner zu speichern, ohne es zu senden?

antworten

Report

Jeremy Kristall

vor etwa 2 Jahren

#33681

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Ich denke, Geoff bedeutet, einen bestimmten Ordner im Code angeben zu können, in dem das PDF jedes Mal gespeichert wird, anstatt den Speicherort manuell auswählen zu müssen. Das PDF wird dann aus diesem bestimmten Ordner per E-Mail gesendet.

antworten

Kristall Jeremy

vor etwa 2 Jahren

#33682

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Danke Jeremy.

antworten

Report

Kristall Geoff

vor etwa 2 Jahren

#33683

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Hallo Geoff, wenn Sie die PDF-Datei automatisch in einem bestimmten Ordner speichern möchten, anstatt den Speicherort manuell auszuwählen, versuchen Sie bitte den folgenden Code. Vergessen Sie nicht, den Ordnerpfad im Code zu ändern.
Unter SpeichernAlsPDFundSenden()
Dim xSht als Arbeitsblatt
Dim xFileDlg As FileDialog
Dim xFolder als String
Dim xYesorNo als ganze Zahl
Dim xOutlookObj als Objekt
Dim xEmailObj als Objekt
Dim xUsedRng As Range
Dim xPath als Zeichenfolge
Setzen Sie xSht = ActiveSheet
xPfad = "C:\Users\Win10x64Test\Desktop\worksheet in pdf„Hier ist „workshet to pdf“ der Zielordner zum Speichern der PDF-Dateien
xFolder = xPath + "\" + xSht.Name + ".pdf"
Wenn Len(Dir(xFolder)) > 0 dann
xYesorNo = MsgBox(xFolder & " bereits vorhanden." & vbCrLf & vbCrLf & "Möchten Sie es überschreiben?", _
vbYesNo + vbQuestion, "Datei existiert")
On Error Resume Next
Wenn xJaoderNein = vbJa Dann
xFolder töten
sonst
MsgBox "Wenn Sie das vorhandene PDF nicht überschreiben, kann ich nicht fortfahren." _
& vbCrLf & vbCrLf & "Drücken Sie OK, um dieses Makro zu beenden.", vbCritical, "Makro wird beendet"
Exit Sub
End If
Wenn Err.Number <> 0 Then
MsgBox "Vorhandene Datei kann nicht gelöscht werden. Bitte stellen Sie sicher, dass die Datei nicht geöffnet oder schreibgeschützt ist." _
& vbCrLf & vbCrLf & "Drücken Sie OK, um dieses Makro zu beenden.", vbCritical, "Datei kann nicht gelöscht werden"
Exit Sub
End If
End If

Legen Sie xUsedRng = xSht.UsedRange fest
Wenn Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
'Als PDF-Datei speichern
xSht.ExportAsFixedFormat Typ:=xlTypePDF, Dateiname:=xFolder, Qualität:=xlQualityStandard

„Outlook-E-Mail erstellen
Setze xOutlookObj = CreateObject("Outlook.Application")
Setze xEmailObj = xOutlookObj.CreateItem(0)
Mit xEmailObj
.Anzeige
.An = ""
.CC = ""
.Betreff = xSht.Name + ".pdf"
.Anlagen.xFolder hinzufügen
Wenn DisplayEmail = False, dann
'.Schicken
End If
Ende mit
sonst
MsgBox "Das aktive Arbeitsblatt darf nicht leer sein"
Exit Sub
End If
End Sub

antworten

Report

Alison

vor etwa 2 Jahren

#34153

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Dieser Code funktioniert hervorragend, außer dass ich das Arbeitsblatt als Blattname + Datum speichern möchte (z. B. Blatt1, 1. Oktober 2020); auf dem Desktop des Benutzers (dies wird von mehreren Personen verwendet und ihre Pfade können leicht variieren). Wenn möglich, möchte ich auch ein .jpg in den Textkörper einbetten. Das JPG befindet sich sowohl innerhalb des Arbeitsblatts (außerhalb des Druckbereichs) als auch das Bild wird auf einem gemeinsam genutzten Server gespeichert. Der Pfad zum Server variiert jedoch je nach Benutzer (für die meisten ist es ein "T"-Laufwerk, für manche ein "U"-Laufwerk)
kann das gemacht werden? bitte und danke tausend mal.

antworten

Deepak

vor etwa 1 Jahr

#34748

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Hallo, es funktioniert großartig, danke fürs Teilen, brauche nur eine Hilfe.
Wenn ich eine PDF-Datei mit einem benutzerdefinierten Namen speichern möchte (Option zum Eingeben des Dateinamens im Dialogfeld Speichern unter), verwenden Sie als Benutzer diese Option in der Formularvorlage, in der Formulare als PDF mit eindeutigem Namen gespeichert werden.

antworten

Report

Kristall Deepak

vor etwa 1 Jahr

#34749

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Hallo, versuchen Sie bitte den folgenden VBA-Code. Nachdem Sie den Code ausgeführt haben, wählen Sie einen Ordner zum Speichern der PDF-Datei aus, dann wird ein Dialogfeld angezeigt, in dem Sie den Dateinamen eingeben können. Sub Als PDF speichern und senden ()
'Aktualisiert von Extendoffice 20210209
Dim xSht als Arbeitsblatt
Dim xFileDlg As FileDialog
Dim xFolder als String
Dim xYesorNo als ganze Zahl
Dim xOutlookObj als Objekt
Dim xEmailObj als Objekt
Dim xUsedRng As Range
Dim xStrName als Zeichenfolge
Dim xV als Variante

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

Wenn xFileDlg.Show = True, dann
xFolder = xFileDlg.SelectedItems(1)
sonst
MsgBox "Sie müssen einen Ordner angeben, in dem das PDF gespeichert werden soll." & vbCrLf & vbCrLf & "Drücken Sie OK, um dieses Makro zu beenden.", vbCritical, "Zielordner muss angegeben werden"
Exit Sub
End If
xStrName = ""
xV = Application.InputBox("Bitte geben Sie den Dateinamen ein:", "Kutools for Excel", , , , , , 2)
Wenn xV = False dann
Exit Sub
End If
xStrName = xV
Wenn xStrName = "" Dann
MsgBox ("Kein Dateiname eingegeben, Vorgang wird beendet!")
Exit Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
'Überprüfen Sie, ob die Datei bereits existiert
Wenn Len(Dir(xFolder)) > 0 dann
xYesorNo = MsgBox(xFolder & " bereits vorhanden." & vbCrLf & vbCrLf & "Möchten Sie es überschreiben?", _
vbYesNo + vbQuestion, "Datei existiert")
On Error Resume Next
Wenn xJaoderNein = vbJa Dann
xFolder töten
sonst
MsgBox "Wenn Sie das vorhandene PDF nicht überschreiben, kann ich nicht fortfahren." _
& vbCrLf & vbCrLf & "Drücken Sie OK, um dieses Makro zu beenden.", vbCritical, "Makro wird beendet"
Exit Sub
End If
Wenn Err.Number <> 0 Then
MsgBox "Vorhandene Datei kann nicht gelöscht werden. Bitte stellen Sie sicher, dass die Datei nicht geöffnet oder schreibgeschützt ist." _
& vbCrLf & vbCrLf & "Drücken Sie OK, um dieses Makro zu beenden.", vbCritical, "Datei kann nicht gelöscht werden"
Exit Sub
End If
End If

Legen Sie xUsedRng = xSht.UsedRange fest
Wenn Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
'Als PDF-Datei speichern
xSht.ExportAsFixedFormat Typ:=xlTypePDF, Dateiname:=xFolder, Qualität:=xlQualityStandard

„Outlook-E-Mail erstellen
Setze xOutlookObj = CreateObject("Outlook.Application")
Setze xEmailObj = xOutlookObj.CreateItem(0)
Mit xEmailObj
.Anzeige
.An = ""
.CC = ""
.Betreff = xSht.Name + ".pdf"
.Anlagen.xFolder hinzufügen
Wenn DisplayEmail = False, dann
'.Schicken
End If
Ende mit
sonst
MsgBox "Das aktive Arbeitsblatt darf nicht leer sein"
Exit Sub
End If
End Sub

antworten

Report

mleczus94

vor etwa 1 Jahr

#35017

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Hallo,
Wenn ich zwei Blätter in der Datei habe und dieses Makro auf einem Blatt ausführen möchte (durch Drücken der Taste), aber ein anderes senden möchte, wie kann ich es bekommen?

antworten

Report

huh

vor etwa 1 Jahr

#35061

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Hallo, ich möchte dies an einem bestimmten Dateispeicherort speichern, wobei der Name auf dem Wert in Zelle C30 basiert. Ich habe einige Optionen ausprobiert, bekomme aber immer wieder Fehler.

antworten

Kristall huh

vor etwa 1 Jahr

#35062

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Hallo Hein, der folgende Code kann vielleicht helfen. Nachdem Sie den Code ausgeführt haben, wählen Sie einen bestimmten Ordner aus, um die PDF-Datei zu speichern, dann wird ein Dialogfeld angezeigt, in dem Sie den Dateinamen eingeben können. Sub Als PDF speichern und senden ()
'Aktualisiert von Extendoffice 20210209
Dim xSht als Arbeitsblatt
Dim xFileDlg As FileDialog
Dim xFolder als String
Dim xYesorNo als ganze Zahl
Dim xOutlookObj als Objekt
Dim xEmailObj als Objekt
Dim xUsedRng As Range
Dim xStrName als Zeichenfolge
Dim xV als Variante

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

Wenn xFileDlg.Show = True, dann
xFolder = xFileDlg.SelectedItems(1)
sonst
MsgBox "Sie müssen einen Ordner angeben, in dem das PDF gespeichert werden soll." & vbCrLf & vbCrLf & "Drücken Sie OK, um dieses Makro zu beenden.", vbCritical, "Zielordner muss angegeben werden"
Exit Sub
End If
xStrName = ""
xV = Application.InputBox("Bitte geben Sie den Dateinamen ein:", "Kutools for Excel", , , , , , 2)
Wenn xV = False dann
Exit Sub
End If
xStrName = xV
Wenn xStrName = "" Dann
MsgBox ("Kein Dateiname eingegeben, Vorgang wird beendet!")
Exit Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
'Überprüfen Sie, ob die Datei bereits existiert
Wenn Len(Dir(xFolder)) > 0 dann
xYesorNo = MsgBox(xFolder & " bereits vorhanden." & vbCrLf & vbCrLf & "Möchten Sie es überschreiben?", _
vbYesNo + vbQuestion, "Datei existiert")
On Error Resume Next
Wenn xJaoderNein = vbJa Dann
xFolder töten
sonst
MsgBox "Wenn Sie das vorhandene PDF nicht überschreiben, kann ich nicht fortfahren." _
& vbCrLf & vbCrLf & "Drücken Sie OK, um dieses Makro zu beenden.", vbCritical, "Makro wird beendet"
Exit Sub
End If
Wenn Err.Number <> 0 Then
MsgBox "Vorhandene Datei kann nicht gelöscht werden. Bitte stellen Sie sicher, dass die Datei nicht geöffnet oder schreibgeschützt ist." _
& vbCrLf & vbCrLf & "Drücken Sie OK, um dieses Makro zu beenden.", vbCritical, "Datei kann nicht gelöscht werden"
Exit Sub
End If
End If

Legen Sie xUsedRng = xSht.UsedRange fest
Wenn Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
'Als PDF-Datei speichern
xSht.ExportAsFixedFormat Typ:=xlTypePDF, Dateiname:=xFolder, Qualität:=xlQualityStandard

„Outlook-E-Mail erstellen
Setze xOutlookObj = CreateObject("Outlook.Application")
Setze xEmailObj = xOutlookObj.CreateItem(0)
Mit xEmailObj
.Anzeige
.An = ""
.CC = ""
.Betreff = xSht.Name + ".pdf"
.Anlagen.xFolder hinzufügen
Wenn DisplayEmail = False, dann
'.Schicken
End If
Ende mit
sonst
MsgBox "Das aktive Arbeitsblatt darf nicht leer sein"
Exit Sub
End If
End Sub

antworten

Report

Hein Kristall

vor etwa 1 Jahr

#35063

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Danke dafür, das ist großartig, aber ich möchte, dass das Blatt wie in Zelle A1 auf Blatt 1 benannt wird. Der Ort zum Speichern gemäß A1 auf Blatt 2, zum Beispiel C:\Users\peete\Dropbox\Screenshots, und E-Mail senden an E-Mail-Adresse auf A3-Blatt 2, was ich bereits ausgearbeitet habe.

antworten

HeinPeeters Kristall

vor etwa 1 Jahr

#35064

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Danke dafür, das ist großartig, aber ich möchte, dass das Blatt wie in Zelle A1 auf Blatt 1 benannt wird. Der Ort, an dem es wie in A1 auf Blatt 2 gespeichert werden soll, zum Beispiel C:\Users\peete\Dropbox\Screenshots, kann sich aber ändern wann Verwenden Sie die Datei und senden Sie eine E-Mail an die E-Mail-Adresse auf A3-Blatt 2, was ich bereits ausgearbeitet habe.

antworten

Report

BenSpo

vor etwa 1 Jahr

#35283

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Hi Kristall , ausgezeichneter Code, danke fürs Teilen. Gibt es eine Möglichkeit, mehrere Blätter (aus derselben Arbeitsmappe) auszuwählen, um sie jeweils als unabhängiges PDF zu speichern und sie dann alle in einer E-Mail angehängt zu senden?

antworten

Report

Kristall BenSpo

vor etwa 1 Jahr

#35284

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Hallo, der folgende VBA-Code kann Ihnen einen Gefallen tun, bitte versuchen Sie es. In der zwölften Zeile des Codes ersetzen Sie bitte die Blattnamen durch die tatsächlichen Blattnamen in Ihrem Fall.
Sub Als PDF speichern und senden1()
Dim xSht als Arbeitsblatt
Dim xFileDlg As FileDialog
Dim xFolder als String
Dim xYesorNo, I, xNum als Integer
Dim xOutlookObj als Objekt
Dim xEmailObj als Objekt
Dim xUsedRng As Range
Dim xArrShetts als Variante
Dim xPDFNameAddress As String
Dim xStr als Zeichenfolge
xArrShetts = Array("Prüfung", "Blatt1", "Blatt2") 'Geben Sie die Blattnamen, die Sie als pdf-Dateien senden, in Anführungszeichen eingeschlossen ein und trennen Sie sie mit Komma. Stellen Sie sicher, dass der Dateiname keine Sonderzeichen wie \/:"*<>| enthält.

Für I = 0 bis UBound(xArrShetts)
On Error Resume Next
Setze xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))
Wenn xSht.Name <> xArrShetts(I) Then
MsgBox "Arbeitsblatt nicht gefunden, Vorgang beenden:" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
Exit Sub
End If
Weiter

Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
Wenn xFileDlg.Show = True, dann
xFolder = xFileDlg.SelectedItems(1)
sonst
MsgBox "Sie müssen einen Ordner angeben, in dem das PDF gespeichert werden soll." & vbCrLf & vbCrLf & "Drücken Sie OK, um dieses Makro zu beenden.", vbCritical, "Zielordner muss angegeben werden"
Exit Sub
End If
'Überprüfen Sie, ob die Datei bereits existiert
xYesorNo = MsgBox("Wenn gleichnamige Dateien im Zielordner vorhanden sind, wird dem Dateinamen automatisch ein Zahlensuffix hinzugefügt, um die Duplikate zu unterscheiden" & vbCrLf & vbCrLf & "Klicken Sie auf Ja, um fortzufahren, klicken Sie auf Nein, um abzubrechen", _
vbYesNo + vbQuestion, "Datei existiert")
Wenn xYesorNo <> vbYes Then Exit Sub
Für I = 0 bis UBound(xArrShetts)
Setze xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
xNum = 1
Solange nicht (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xNum = xNum + 1
Wend
Legen Sie xUsedRng = xSht.UsedRange fest
Wenn Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
xSht.ExportAsFixedFormat Typ:=xlTypePDF, Dateiname:=xStr, Qualität:=xlQualityStandard
sonst

End If
xArrShetts(I) = xStr
Weiter

„Outlook-E-Mail erstellen
Setze xOutlookObj = CreateObject("Outlook.Application")
Setze xEmailObj = xOutlookObj.CreateItem(0)
Mit xEmailObj
.Anzeige
.An = ""
.CC = ""
.Betreff = "????"
Für I = 0 bis UBound(xArrShetts)
.Anhänge.XArrShetts(I) hinzufügen
Weiter
Wenn DisplayEmail = False, dann
'.Schicken
End If
Ende mit
End Sub

antworten

Report

Berne Rudolph Kristall

vor etwa 1 Jahr

#35285

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Hallo, die einzige Änderung, mit der ich zu kämpfen habe, ist, eine separate E-Mail für jedes erstellte PDF-Dokument zu erstellen.

antworten

Kristall Berne Rudolph

vor etwa 1 Jahr

#35286

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Hallo, um eine separate E-Mail für jedes PDF-Dokument zu erstellen, können Sie die im Beitrag bereitgestellte VBA manuell in verschiedenen Arbeitsblättern ausführen, um dies zu erledigen.

antworten

Report

Berne Rudolph Kristall

vor etwa 1 Jahr

#35287

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Ich habe mehr als 100 Arbeitsblätter in der Arbeitsmappe, was dazu führt, dass ich das VBA mehr als 100 Mal ausführen muss, was zeitaufwändig ist.
Ich habe es geschafft, meine Arbeitsmappe in mehrere Blätter aufzuteilen, und kann dann jedes Arbeitsblatt in ein einzelnes PDF-Dokument konvertieren.
Die Lösung, nach der ich suche, besteht darin, jedes PDF-Dokument separat per E-Mail zu versenden, während der obige Prozess ausgeführt wird.
Hiermit das VBA, das ich gerade ausführe:
Sub Als PDF speichern und senden1()
Dim xSht als Arbeitsblatt
Dim xFileDlg As FileDialog
Dim xFolder als String
Dim xYesorNo, I, xNum als Integer
Dim xOutlookObj als Objekt
Dim xEmailObj als Objekt
Dim xUsedRng As Range
Dim xArrShetts als Variante
Dim xPDFNameAddress As String
Dim xStr als Zeichenfolge
xArrShetts = Array("02302257", "02400438", "02401829", "02403995", "02408001", "02409208", _
"02409980", "02411881", "02424178", "02430454", "02444046", "02448950", "02450600", _
"02459861", "02461750", "02467535", "02480484", "02484749", "02502041", "02504807", _
"02511843", "02515193", "02523098", "02523244", "02524036", "02524548", "02525516", "02525703", "02525898", "02528908", "02528950", _
"02530381", "02531018", "02531252", "02531277", "02532571", "02533053", "02533474", _
"02534176", "02534592", "02534626", "02535343", "02536386", "02536921", "02537544", _
"02537607", "02538015", "02538755", "02538836", "02538910", "02539685", "02540063", "02540139", "02540158", "02541607", "02542344", _
"02543763", "02543985", "02544116", "02544748", "02544762", "02545026", "02545048", _
"02545080", "02545447", "02545730", "02545814", "02546477", "02547458", "02547673", _
"02547833", "02547912", "02547950", "02547991", "02548848", "02549103", "02549116", "02549125", "02549132", "02549140", "02549182", _
"02549462", "02549499", "02549565", "02549687", "02550049", "02550437", "02550812", _
"02550982", "02551004", "02551005", "02551045", "02552099", "02552222", "02552561", _
"02552684", "02552815", "02552892", "02553031", "02553186", "02553628", "02553721", "02555186", "02556934", "02557137", "02557393", _
"02559121", "02559392", "02559419", "02559512", "02559802", "02559868", "02560052", _
"02560612", "02560684", "02560920", "02561018", "02561061", "02561092", "02561227", _
"02561349", "02561592", "02561630", "02561673", "02561880", "02562359", "02562920", "02562934", "02563013", "02563119", "02563133", _
"02563445", "02563737", "02563828", "02563852", "02563861", "02563971", "02564042", _
"02564315", "02564366", "02564832", "02564909", "02565059", "02565205") 'Geben Sie die Blattnamen, die Sie als pdf-Dateien versenden, in Anführungszeichen eingeschlossen und mit Komma trennen. Stellen Sie sicher, dass der Dateiname keine Sonderzeichen wie \/:"*<>| enthält.

Für I = 0 bis UBound(xArrShetts)
On Error Resume Next
Setze xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))
Wenn xSht.Name <> xArrShetts(I) Then
MsgBox "Arbeitsblatt nicht gefunden, Vorgang beenden:" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
Exit Sub
End If
Weiter

Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
Wenn xFileDlg.Show = True, dann
xFolder = xFileDlg.SelectedItems(1)
sonst
MsgBox "Sie müssen einen Ordner angeben, in dem das PDF gespeichert werden soll." & vbCrLf & vbCrLf & "Drücken Sie OK, um dieses Makro zu beenden.", vbCritical, "Zielordner muss angegeben werden"
Exit Sub
End If
'Überprüfen Sie, ob die Datei bereits existiert
xYesorNo = MsgBox("Wenn gleichnamige Dateien im Zielordner vorhanden sind, wird dem Dateinamen automatisch ein Zahlensuffix hinzugefügt, um die Duplikate zu unterscheiden" & vbCrLf & vbCrLf & "Klicken Sie auf Ja, um fortzufahren, klicken Sie auf Nein, um abzubrechen", _
vbYesNo + vbQuestion, "Datei existiert")
Wenn xYesorNo <> vbYes Then Exit Sub
Für I = 0 bis UBound(xArrShetts)
Setze xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
xNum = 1
Solange nicht (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xNum = xNum + 1
Wend
Legen Sie xUsedRng = xSht.UsedRange fest
Wenn Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
xSht.ExportAsFixedFormat Typ:=xlTypePDF, Dateiname:=xStr, Qualität:=xlQualityStandard
sonst

End If
xArrShetts(I) = xStr
Weiter

„Outlook-E-Mail erstellen
Setze xOutlookObj = CreateObject("Outlook.Application")
Setze xEmailObj = xOutlookObj.CreateItem(0)
Mit xEmailObj
.Anzeige
.To = "Ctracklegal@ctrack.com"
.CC = ""
.Betreff = "????"
Für I = 0 bis UBound(xArrShetts)
On Error Resume Next
.Anhänge.XArrShetts(I) hinzufügen
Weiter
Wenn DisplayEmail = False, dann
.Senden
Exit Sub
End If
Ende mit

End Sub

antworten

Tori

vor etwa 1 Jahr

#35336

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Hallo @kristall
Das ist fabelhaft - das Wichtigste, mit dem ich zu kämpfen habe, ist der Dateiname - ich möchte, dass der Dateiname aus einer Zelle im Arbeitsblatt gezogen wird, anstatt den Registerkartennamen zu verwenden. Ich habe den Code bereits so bearbeitet, dass er automatisch in einem bestimmten Ordner gespeichert wird, aber ich habe Probleme mit dem Dateinamen.
Können Sie bitte Hilfe anbieten?

antworten

Kristall Tori

vor etwa 1 Jahr

#35337

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Hallo Tori, wenn Sie die PDF-Datei mit einem bestimmten Zellenwert benennen möchten, versuchen Sie bitte den folgenden Code. Nachdem Sie den Code ausgeführt und einen Ordner zum Speichern der Datei ausgewählt haben, wird ein weiteres Dialogfeld angezeigt. Bitte wählen Sie die Zelle aus, die Sie verwenden möchten Geben Sie den Wert als Namen der PDF-Datei ein und klicken Sie dann zum Abschluss auf OK.
Sub Als PDF speichern und senden2()
'Aktualisiert von Extendoffice 20210521
Dim xSht als Arbeitsblatt
Dim xFileDlg As FileDialog
Dim xFolder als String
Dim xYesorNo als ganze Zahl
Dim xOutlookObj als Objekt
Dim xEmailObj als Objekt
Dim xUsedRng, xRgInser als Bereich
Dim xB als boolescher Wert
Setzen Sie xSht = ActiveSheet
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Wenn xFileDlg.Show = True, dann
xFolder = xFileDlg.SelectedItems(1)
sonst
MsgBox "Sie müssen einen Ordner angeben, in dem das PDF gespeichert werden soll." & vbCrLf & vbCrLf & "Drücken Sie OK, um dieses Makro zu beenden.", vbCritical, "Zielordner muss angegeben werden"
Exit Sub
End If
xB = wahr
On Error Resume Next
Während xB
Setze xRgInser = nichts
Set xRgInser = Application.InputBox("Wählen Sie eine Zelle aus, deren Wert Sie zum Benennen der PDF-Datei verwenden:", "Kutools for Excel", , , , , , 8)
Wenn xRgInser dann nichts ist
MsgBox "Keine Zelle ausgewählt, Vorgang beenden!", vbInformation, "Kutools for Excel"
Exit Sub
End If
Wenn xRgInser.Text = "" Dann
MsgBox "Die ausgewählte Zelle ist leer, bitte erneut auswählen!", vbInformation, "Kutools for Excel"
sonst
xB = Falsch
End If
Wend

xFolder = xFolder + "\" + xRgInser.Text + ".pdf"

'Überprüfen Sie, ob die Datei bereits existiert
Wenn Len(Dir(xFolder)) > 0 dann
xYesorNo = MsgBox(xFolder & " bereits vorhanden." & vbCrLf & vbCrLf & "Möchten Sie es überschreiben?", _
vbYesNo + vbQuestion, "Datei existiert")
On Error Resume Next
Wenn xJaoderNein = vbJa Dann
xFolder töten
sonst
MsgBox "Wenn Sie das vorhandene PDF nicht überschreiben, kann ich nicht fortfahren." _
& vbCrLf & vbCrLf & "Drücken Sie OK, um dieses Makro zu beenden.", vbCritical, "Makro wird beendet"
Exit Sub
End If
Wenn Err.Number <> 0 Then
MsgBox "Vorhandene Datei kann nicht gelöscht werden. Bitte stellen Sie sicher, dass die Datei nicht geöffnet oder schreibgeschützt ist." _
& vbCrLf & vbCrLf & "Drücken Sie OK, um dieses Makro zu beenden.", vbCritical, "Datei kann nicht gelöscht werden"
Exit Sub
End If
End If

Legen Sie xUsedRng = xSht.UsedRange fest
Wenn Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
'Als PDF-Datei speichern
xSht.ExportAsFixedFormat Typ:=xlTypePDF, Dateiname:=xFolder, Qualität:=xlQualityStandard

„Outlook-E-Mail erstellen
Setze xOutlookObj = CreateObject("Outlook.Application")
Setze xEmailObj = xOutlookObj.CreateItem(0)
Mit xEmailObj
.Anzeige
.An = ""
.CC = ""
.Betreff = xSht.Name + ".pdf"
.Anlagen.xFolder hinzufügen
Wenn DisplayEmail = False, dann
'.Schicken
End If
Ende mit
sonst
MsgBox "Das aktive Arbeitsblatt darf nicht leer sein"
Exit Sub
End If
End Sub

antworten

Report

Makeeuropeanu

vor etwa 1 Jahr

#35342

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Hallo, ich brauchte etwas Ähnliches, also habe ich Folgendes bekommen. Es nimmt das aktuelle Datum und erstellt einen neuen Ordner mit dem Datumsnamen an einem bestimmten Ort. Es platziert das PDF an diesem neuen Ort und fügt das PDF dann an eine neue E-Mail an. Funktioniert als Leckerbissen. Ich bin nur ein Anfänger, also entschuldigen Sie mich bitte, wenn es wie ein Durcheinander aussieht. :D
Unter PDFTOEMAIL()
Dim xSht als Arbeitsblatt
Dim xFileDlg As FileDialog
Dim xFolder als String
Dim xYesorNo als ganze Zahl
Dim xOutlookObj als Objekt
Dim xEmailObj als Objekt
Dim xUsedRng As Range
Dim xPath als Zeichenfolge
Dim xOutMsg als Zeichenfolge
Dim sFolderName als String, sFolder als String
Dim sFolderPath As String

Setzen Sie xSht = ActiveSheet
xFileDate = Format (jetzt "dd-mm-yyyy")
sFolder = "C:" 'Hier haben Sie einen Hauptordner
sFolderName = "Week ending" + Format(Now, "dd-mm-yyyy") 'Ordner, der im Hauptordner mit dem Namen Week ending und dem aktuellen Datum erstellt werden soll
sFolderPath = "C:" & sFolderName 'Hauptordner erneut, um den neuen Pfad einschließlich des neuen Ordners zu erstellen
Set oFSO = CreateObject("Scripting.FileSystemObject")
If oFSO.FolderExists(sFolderPath) Then
MsgBox "Ordner existiert bereits !" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
sonst
MkDir sFolderPath
MsgBox "Neuer Ordner wurde erstellt!" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
End If
xPath = sFolderPath
xFolder = xPath + "\" + xSht.Name + "_" + xFileDate + ".pdf"
Wenn Len(Dir(xFolder)) > 0 dann
xYesorNo = MsgBox(xFolder & " bereits vorhanden." & vbCrLf & vbCrLf & "Möchten Sie es überschreiben?", _
vbYesNo + vbQuestion, "Datei existiert")
On Error Resume Next
Wenn xJaoderNein = vbJa Dann
xFolder töten
sonst
MsgBox "Wenn Sie das vorhandene PDF nicht überschreiben, kann ich nicht fortfahren." _
& vbCrLf & vbCrLf & "Drücken Sie OK, um dieses Makro zu beenden.", vbCritical, "Makro wird beendet"
Exit Sub
End If
Wenn Err.Number <> 0 Then
MsgBox "Vorhandene Datei kann nicht gelöscht werden. Bitte stellen Sie sicher, dass die Datei nicht geöffnet oder schreibgeschützt ist." _
& vbCrLf & vbCrLf & "Drücken Sie OK, um dieses Makro zu beenden.", vbCritical, "Datei kann nicht gelöscht werden"
Exit Sub
End If
End If

Legen Sie xUsedRng = xSht.UsedRange fest
Wenn Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
xSht.ExportAsFixedFormat Typ:=xlTypePDF, Dateiname:=xFolder, Qualität:=xlQualityStandard
Setze xOutlookObj = CreateObject("Outlook.Application")
Setze xEmailObj = xOutlookObj.CreateItem(0)
xOutMsg = " Bitte finden Sie im Anhang Diese E-Mail und der Anhang wurden automatisch generiert "
' fügt einen Hinweis hinzu, dass die E-Mail automatisch generiert wurde

Mit xEmailObj
.Anzeige
.To = "" 'fügen Sie Ihre eigenen E-Mails hinzu
.CC = ""
.Subject = xSht.Name + "PDF für Wochenend" + xFileDate + "-Location" 'Thema enthält Blattname, PDF, Datum und Ort, dies kann nach Bedarf bearbeitet werden
.Anlagen.xFolder hinzufügen
.HTMLBody = xOutMsg & .HTMLBody
Wenn DisplayEmail = False, dann
'.Senden <--- Wenn Sie hier das Apostroph löschen, wird die E-Mail automatisch versendet, seien Sie also vorsichtig
End If
Ende mit
sonst
MsgBox "Das aktive Arbeitsblatt darf nicht leer sein"
Exit Sub
End If
End Sub

antworten

Report

Nicole

vor etwa 1 Jahr

#35677

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Wie bearbeite ich diesen Code, um nur Zellen ("a1:r99") zu speichern, um sie als PDF zu speichern. Ich habe Extramaterial an den Seiten, die ich nicht in meinem PDF-Dokument haben möchte.
Sub Als PDF speichern und senden ()
'Aktualisiert von Extendoffice 20210209
Dim xSht als Arbeitsblatt
Dim xFileDlg As FileDialog
Dim xFolder als String
Dim xYesorNo als ganze Zahl
Dim xOutlookObj als Objekt
Dim xEmailObj als Objekt
Dim xUsedRng As Range
Dim xStrName als Zeichenfolge
Dim xV als Variante

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

Wenn xFileDlg.Show = True, dann
xFolder = xFileDlg.SelectedItems(1)
sonst
MsgBox "Sie müssen einen Ordner angeben, in dem das PDF gespeichert werden soll." & vbCrLf & vbCrLf & "Drücken Sie OK, um dieses Makro zu beenden.", vbCritical, "Zielordner muss angegeben werden"
Exit Sub
End If
xStrName = ""
xV = Application.InputBox("Bitte geben Sie den Dateinamen ein:", "Kutools for Excel", , , , , , 2)
Wenn xV = False dann
Exit Sub
End If
xStrName = xV
Wenn xStrName = "" Dann
MsgBox ("Kein Dateiname eingegeben, Vorgang wird beendet!")
Exit Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
'Überprüfen Sie, ob die Datei bereits existiert
Wenn Len(Dir(xFolder)) > 0 dann
xYesorNo = MsgBox(xFolder & " bereits vorhanden." & vbCrLf & vbCrLf & "Möchten Sie es überschreiben?", _
vbYesNo + vbQuestion, "Datei existiert")
On Error Resume Next
Wenn xJaoderNein = vbJa Dann
xFolder töten
sonst
MsgBox "Wenn Sie das vorhandene PDF nicht überschreiben, kann ich nicht fortfahren." _
& vbCrLf & vbCrLf & "Drücken Sie OK, um dieses Makro zu beenden.", vbCritical, "Makro wird beendet"
Exit Sub
End If
Wenn Err.Number <> 0 Then
MsgBox "Vorhandene Datei kann nicht gelöscht werden. Bitte stellen Sie sicher, dass die Datei nicht geöffnet oder schreibgeschützt ist." _
& vbCrLf & vbCrLf & "Drücken Sie OK, um dieses Makro zu beenden.", vbCritical, "Datei kann nicht gelöscht werden"
Exit Sub
End If
End If

Legen Sie xUsedRng = xSht.UsedRange fest
Wenn Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
'Als PDF-Datei speichern
xSht.ExportAsFixedFormat Typ:=xlTypePDF, Dateiname:=xFolder, Qualität:=xlQualityStandard

„Outlook-E-Mail erstellen
Setze xOutlookObj = CreateObject("Outlook.Application")
Setze xEmailObj = xOutlookObj.CreateItem(0)
Mit xEmailObj
.Anzeige
.An = ""
.CC = ""
.Betreff = xSht.Name + ".pdf"
.Anlagen.xFolder hinzufügen
Wenn DisplayEmail = False, dann
'.Schicken
End If
Ende mit
sonst
MsgBox "Das aktive Arbeitsblatt darf nicht leer sein"
Exit Sub
End If
End Sub

antworten

RLF Nicole

vor etwa 1 Jahr

#35678

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Hallo, ich habe diesen Code gerade auf einem meiner Arbeitsblätter ausprobiert und ich habe Druckbereiche so eingestellt, dass das zusätzliche Material unten nicht im PDF angezeigt wird. Versuch es!

antworten

Rod Bennett

vor etwa 1 Jahr

#35699

Dieser Kommentar wurde vom Moderator auf der Website minimiert

Hi
Vielen Dank für den Code, aber ist es möglich, das PDF automatisch am selben Ort wie die aktive Excel-Datei und mit demselben Dateinamen wie die aktive Excel-Datei zu speichern?
Vielen Dank.
Stange

antworten

Es sind noch keine Kommentare vorhanden

Mehr laden

Hinterlassen Sie Ihre Kommentare

Als Gast posten

Einloggen

Name (erforderlich)

E-Mail (Pflichtfeld)

Bewerte diese Nachricht:

Zurücksetzen

0 Figuren

Ich akzeptiere die Bedingungen und den Zustand