Note: The other languages of the website are Google-translated. Back to English
Inloggen Registreer

Hoe een werkblad als pdf-bestand opslaan en als bijlage via Outlook e-mailen?

In sommige gevallen moet u mogelijk een werkblad als pdf-bestand via Outlook verzenden. Meestal moet u het werkblad handmatig opslaan als een PDF-bestand, vervolgens een nieuwe e-mail met dit PDF-bestand als bijlage in uw Outlook maken en het ten slotte verzenden. Het is tijdrovend om dit stap voor stap handmatig te realiseren. In dit artikel laten we u zien hoe u snel een werkblad als pdf-bestand opslaat en automatisch als bijlage via Outlook in Excel verstuurt.

Sla een werkblad op als pdf-bestand en e-mail het als bijlage met VBA-code

Sla een werkblad op als pdf-bestand en e-mail het als bijlage met VBA-code

U kunt de onderstaande VBA-code uitvoeren om het actieve werkblad automatisch op te slaan als een PDF-bestand en het vervolgens als bijlage via Outlook e-mailen. Ga als volgt te werk.

1. Open het werkblad dat u als pdf wilt opslaan en verzend, en druk vervolgens op anders + F11 toetsen tegelijkertijd om het Microsoft Visual Basic voor toepassingen venster.

2. In de Microsoft Visual Basic voor toepassingen venster klikt Invoegen > Module. Kopieer en plak vervolgens de onderstaande VBA-code in het Code venster. Zie screenshot:

VBA-code: sla een werkblad op als PDF-bestand en e-mail het als bijlage

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. druk de F5 sleutel om de code uit te voeren. In de Blader dialoogvenster, selecteer een map om dit PDF-bestand op te slaan en klik vervolgens op het OK knop.

Notes:

1. Nu wordt het actieve werkblad opgeslagen als PDF-bestand. En het PDF-bestand krijgt de naam van de werkbladnaam.
2. Als het actieve werkblad leeg is, krijgt u een dialoogvenster zoals hieronder afgebeeld nadat u op de OK knop.

4. Nu wordt een nieuwe Outlook-e-mail aangemaakt en kunt u zien dat het PDF-bestand als bijlage wordt vermeld in het veld Bijgevoegd. Zie screenshot:

5. Stel deze e-mail op en verstuur hem.
6. Deze code is alleen beschikbaar als u Outlook als uw e-mailprogramma gebruikt.

Bewaar eenvoudig een werkblad of meerdere werkbladen als afzonderlijke PDF-bestanden tegelijk:

Het Werkmap splitsen nut van Kutools for Excel kan u helpen gemakkelijk een werkblad of meerdere werkbladen als afzonderlijke PDF-bestanden tegelijk op te slaan, zoals de onderstaande demo laat zien. Download en probeer het nu! (30 dagen gratis parcours)

Gerelateerde artikelen:

De beste tools voor kantoorproductiviteit

Kutools voor Excel lost de meeste van uw problemen op en verhoogt uw productiviteit met 80%

  • visfuik: Snel invoegen complexe formules, grafieken en alles wat je eerder hebt gebruikt; Versleutel cellen met wachtwoord; Maak een mailinglijst en stuur e-mails ...
  • Super Formula-balk (bewerk eenvoudig meerdere regels tekst en formule); Lay-out lezen (gemakkelijk grote aantallen cellen lezen en bewerken); Plakken in gefilterd bereik...
  • Voeg cellen / rijen / kolommen samen zonder gegevens te verliezen; Gespleten cellen inhoud; Combineer dubbele rijen / kolommen... Voorkom dubbele cellen; Vergelijk Ranges...
  • Selecteer Dupliceren of Uniek Rijen; Selecteer lege rijen (alle cellen zijn leeg); Super zoeken en fuzzy zoeken in veel werkboeken; Willekeurige selectie ...
  • Exacte kopie Meerdere cellen zonder de formuleverwijzing te wijzigen; Maak automatisch verwijzingen naar meerdere bladen; Plaats kogels, Selectievakjes en meer ...
  • Extraheer tekst, Tekst toevoegen, Verwijderen op positie, Ruimte verwijderen; Paging-subtotalen maken en afdrukken; Converteren tussen celinhoud en opmerkingen...
  • Super filter (bewaar en pas filterschema's toe op andere bladen); Geavanceerd sorteren per maand / week / dag, frequentie en meer; Speciaal filter door vet, cursief ...
  • Combineer werkmappen en werkbladen; Tabellen samenvoegen op basis van sleutelkolommen; Gegevens splitsen in meerdere bladen; Batch Converteer xls, xlsx en PDF...
  • Meer dan 300 krachtige functies. Ondersteunt Office / Excel 2007-2019 en 365. Ondersteunt alle talen. Eenvoudig te implementeren in uw onderneming of organisatie. Gratis proefperiode van 30 dagen met volledige functies. 60 dagen geld-terug-garantie.
kte tabblad 201905

Office-tabblad Brengt een interface met tabbladen naar Office en maakt uw werk veel gemakkelijker

  • Schakel bewerken en lezen met tabbladen in Word, Excel, PowerPoint in, Publisher, Access, Visio en Project.
  • Open en maak meerdere documenten in nieuwe tabbladen van hetzelfde venster in plaats van in nieuwe vensters.
  • Verhoogt uw productiviteit met 50% en vermindert elke dag honderden muisklikken!
officetab onderkant
Comments (52)
Nog geen beoordelingen. Beoordeel als eerste!
Michael
Michael
Deze opmerking is gemaakt door de moderator op de site
Dit werkt prima voor mij, maar is er een manier om automatisch een maplocatie te selecteren in plaats van handmatig te selecteren? Ik hoop dit voor 40 vellen tegelijk te doen.
Antwoorden
Hugh
Hugh     Michael
Deze opmerking is gemaakt door de moderator op de site
Hoop ook op een antwoord op dit probleem! Bedankt voor de hulp!
Antwoorden
Darren
Darren
Deze opmerking is gemaakt door de moderator op de site
Ik heb geprobeerd dit in een nieuwe module te plakken en ik krijg Compileerfout: Sub of Functie niet gedefinieerd. Help alstublieft.
Antwoorden
crystal
crystal     Darren
Deze opmerking is gemaakt door de moderator op de site
Beste Darren,
Welke Office-versie gebruik je?
Antwoorden
Rapport
Nakia
Nakia     crystal
Deze opmerking is gemaakt door de moderator op de site
Office 360
Antwoorden
Bill
Bill     Darren
Deze opmerking is gemaakt door de moderator op de site
Zelfde probleem
Antwoorden
Michael Charlie
Michael Charlie
Deze opmerking is gemaakt door de moderator op de site
Hoe zou ik het bovenstaande VBA-script bewerken, zodat het een datum- en tijdstempel aan de bestandsnaam toevoegt, zodat het niet blijft overschrijven wat al is opgeslagen?
Antwoorden
Rapport
crystal
crystal     Michael Charlie
Deze opmerking is gemaakt door de moderator op de site
Beste Michael,
Voer de onderstaande VBA-code uit om het probleem op te lossen.

Sub Saveaspdfandsend()
Dim xSht als werkblad
Dim xFileDlg As FileDialog
Dim xFolder als string
Dim xJaofNee Als geheel getal
Dim xOutlookObj als object
Dim xEmailObj als object
Dim xUsedRng As Range
Dim xStr As String

Stel xSht = ActiveSheet in
Stel xFileDlg = Application.FileDialog (msoFileDialogFolderPicker) in

Als xFileDlg.Show = True Dan
xFolder = xFileDlg.SelectedItems(1)
Anders
MsgBox "U moet een map specificeren om de PDF in op te slaan." & vbCrLf & vbCrLf & "Druk op OK om deze macro af te sluiten.", vbCritical, "Moet de doelmap opgeven"
Exit Sub
End If
xStr = Formaat(Now(), "jjjj-mm-dd-uu-mm-ss")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'Controleer of het bestand al bestaat
Als Len(Dir(xFolder)) > 0 Dan
xYesorNo = MsgBox(xFolder & " bestaat al." & vbCrLf & vbCrLf & "Wilt u het overschrijven?", _
vbJaNee + vbVraag, "Bestand bestaat")
On Error Resume Next
Als xJaofNee = vbJa Dan
Kill xFolder
Anders
MsgBox "Als u de bestaande PDF niet overschrijft, kan ik niet verder." _
& vbCrLf & vbCrLf & "Druk op OK om deze macro af te sluiten.", vbCritical, "Macro afsluiten"
Exit Sub
End If
Als Foutnummer <> 0 Dan
MsgBox "Kan het bestaande bestand niet verwijderen. Controleer of het bestand niet geopend of tegen schrijven is beveiligd." _
& vbCrLf & vbCrLf & "Druk op OK om deze macro af te sluiten.", vbCritical, "Kan bestand niet verwijderen"
Exit Sub
End If
End If

Stel xUsedRng = xSht.UsedRange in
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Dan
'Opslaan als pdf-bestand'
xSht.ExportAsFixedFormat Type:=xlTypePDF, Bestandsnaam:=xFolder, Kwaliteit:=xlQualityStandard

'Maak Outlook e-mail aan'
Stel xOutlookObj = CreateObject ("Outlook.Application") in
Stel xEmailObj = xOutlookObj.CreateItem(0) in
Met xEmailObj
.Scherm
.Naar = ""
.CC = ""
.Onderwerp = xSht.Naam + "-" + xStr + ".pdf"
.Bijlagen.Toevoegen xFolder
Als DisplayEmail = False Dan
'.Versturen
End If
Eindigt met
Anders
MsgBox "Het actieve werkblad mag niet leeg zijn"
Exit Sub
End If
End Sub
Antwoorden
Rapport
Parag Somani
Parag Somani     crystal
Deze opmerking is gemaakt door de moderator op de site
Hallo Kristal,

Het is echt geweldig en werkt perfect voor mij. Meer hulp nodig om toe te voegen:

1. in "Aan" wil ik een link geven naar een bepaalde cel van het actieve blad, zoals wijs in CC en in BCC wil ik een actieve bladlink toevoegen
2. in de hoofdtekst van de e-mail moet ik een standaardtekst opgeven.

Ik zal geweldig voor je zijn voor je hulp.

Bedankt
parag
Antwoorden
crystal
crystal     Parag Somani
Deze opmerking is gemaakt door de moderator op de site
Hallo Parag Somani,
De onderstaande VBA-code kan u helpen. Wijzig de velden .To, .CC, .BCC en .Body op basis van uw behoeften.

Sub Saveaspdfandsend()
Dim xSht als werkblad
Dim xFileDlg As FileDialog
Dim xFolder als string
Dim xJaofNee Als geheel getal
Dim xOutlookObj als object
Dim xEmailObj als object
Dim xUsedRng As Range
Dim xStr As String

Stel xSht = ActiveSheet in
Stel xFileDlg = Application.FileDialog (msoFileDialogFolderPicker) in

Als xFileDlg.Show = True Dan
xFolder = xFileDlg.SelectedItems(1)
Anders
MsgBox "U moet een map specificeren om de PDF in op te slaan." & vbCrLf & vbCrLf & "Druk op OK om deze macro af te sluiten.", vbCritical, "Moet de doelmap opgeven"
Exit Sub
End If
xStr = Formaat(Now(), "jjjj-mm-dd-uu-mm-ss")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'Controleer of het bestand al bestaat
Als Len(Dir(xFolder)) > 0 Dan
xYesorNo = MsgBox(xFolder & " bestaat al." & vbCrLf & vbCrLf & "Wilt u het overschrijven?", _
vbJaNee + vbVraag, "Bestand bestaat")
On Error Resume Next
Als xJaofNee = vbJa Dan
Kill xFolder
Anders
MsgBox "Als u de bestaande PDF niet overschrijft, kan ik niet verder." _
& vbCrLf & vbCrLf & "Druk op OK om deze macro af te sluiten.", vbCritical, "Macro afsluiten"
Exit Sub
End If
Als Foutnummer <> 0 Dan
MsgBox "Kan het bestaande bestand niet verwijderen. Controleer of het bestand niet geopend of tegen schrijven is beveiligd." _
& vbCrLf & vbCrLf & "Druk op OK om deze macro af te sluiten.", vbCritical, "Kan bestand niet verwijderen"
Exit Sub
End If
End If

Stel xUsedRng = xSht.UsedRange in
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Dan
'Opslaan als pdf-bestand'
xSht.ExportAsFixedFormat Type:=xlTypePDF, Bestandsnaam:=xFolder, Kwaliteit:=xlQualityStandard

'Maak Outlook e-mail aan'
Stel xOutlookObj = CreateObject ("Outlook.Application") in
Stel xEmailObj = xOutlookObj.CreateItem(0) in
Met xEmailObj
.Scherm
.To = Bereik ("A8")
.CC = Bereik ("A9")
.BCC = Bereik ("A10")
.Onderwerp = xSht.Naam + "-" + xStr + ".pdf"
.Lichaam = "Beste" _
& vbNieuweLijn & vbNieuweLijn & _
"Dit is een testmail" & _
"verzenden in Excel"
.Bijlagen.Toevoegen xFolder
Als DisplayEmail = False Dan
'.Versturen
End If
Eindigt met
Anders
MsgBox "Het actieve werkblad mag niet leeg zijn"
Exit Sub
End If
End Sub
Antwoorden
Rapport
Mehul
Mehul     crystal
Deze opmerking is gemaakt door de moderator op de site
Ik heb geprobeerd het bereik te gebruiken voor "To", "CC", het haalt gewoon niet de waarden op uit de aangewezen cel. Kunt u hierbij alstublieft helpen?
Hartelijk dank,
Mehul
Antwoorden
Parag Somani
Parag Somani     crystal
Deze opmerking is gemaakt door de moderator op de site
Hallo Kristal,

Het is echt geweldig en werkt perfect voor mij. Meer hulp nodig om toe te voegen:

1. in "Aan" wil ik een link geven naar een bepaalde cel van het actieve blad, zoals wijs in CC en in BCC wil ik een actieve bladlink toevoegen
2. in de hoofdtekst van de e-mail moet ik een standaardtekst opgeven.

Ik zal geweldig voor je zijn voor je hulp.

Bedankt
parag
Antwoorden
parag
parag     crystal
Deze opmerking is gemaakt door de moderator op de site
Hallo Kristal,

Het is echt geweldig en werkt perfect voor mij. Meer hulp nodig om toe te voegen:

1. in "Aan" wil ik een link geven naar een bepaalde cel van het actieve blad, zoals wijs in CC en in BCC wil ik een actieve bladlink toevoegen
2. in de hoofdtekst van de e-mail moet ik een standaardtekst opgeven.

Ik zal geweldig voor je zijn voor je hulp.

Bedankt
parag
Antwoorden
Rapport
Armin
Armin
Deze opmerking is gemaakt door de moderator op de site
Hoe kan ik bijvoorbeeld blad 2 uit de werkmap als pdf toevoegen?
Antwoorden
crystal
crystal     Armin
Deze opmerking is gemaakt door de moderator op de site
Hallo Armin,
U moet eerst Blad 2 in uw werkmap openen en vervolgens de VBA-code uitvoeren met bovenstaande stappen om het op te halen.
Antwoorden
Rapport
Tom H.
Tom H.
Deze opmerking is gemaakt door de moderator op de site
Hoe zou ik het bovenstaande VBA-script bewerken, zodat de bestandsnaam wordt opgeslagen als een specifieke cel die is geselecteerd in het huidige blad, bijvoorbeeld cel A1?
Antwoorden
crystal
crystal     Tom H.
Deze opmerking is gemaakt door de moderator op de site
Hallo Tom.
Sorry kan hier niet mee helpen.
Welkom bij het plaatsen van een vraag op ons forum: https://www.extendoffice.com/forum.html
Je krijgt meer Excel-ondersteuning van onze Excel-professional of andere Excel-fans.
Antwoorden
Rapport
james
james
Deze opmerking is gemaakt door de moderator op de site
Hallo, hoe kan ik de pdf opslaan en verzenden met de naam van de werkmap met de huidige VBA-code? wat gebruik ik in plaats van xSht.Name
Antwoorden
crystal
crystal     james
Deze opmerking is gemaakt door de moderator op de site
Hi James,
Wilt u het actieve werkblad als pdf verzenden en het de naam van de werkmap noemen?
Antwoorden
Rapport
ranga
ranga
Deze opmerking is gemaakt door de moderator op de site
Bedankt het werkt.
Antwoorden
Jason
Jason
Deze opmerking is gemaakt door de moderator op de site
Hoe kan ik ervoor zorgen dat de opgeslagen pdf wordt verwijderd nadat deze is ge-e-maild?
Antwoorden
crystal
crystal     Jason
Deze opmerking is gemaakt door de moderator op de site
Hallo Jason,
Sorry kan je daar nog niet mee helpen. U moet het handmatig verwijderen nadat u het heeft gemaild.
Antwoorden
Rapport
Odd-Inge
Odd-Inge
Deze opmerking is gemaakt door de moderator op de site
Hallo,

Is het mogelijk om de naam voor pdf uit een cel te vinden? Ex. cel H4


En in cel H4 wil ik dat het uit drie verschillende cellen wordt verzameld. Is dit mogelijk?
Antwoorden
Taylor
Taylor     Odd-Inge
Deze opmerking is gemaakt door de moderator op de site
Dit is mogelijk. Maak afzonderlijke variabelen om de waarde van de cellen vast te houden en gebruik die variabelen vervolgens bij het instellen van xFolder.
Ik gebruikte de waarde uit een cel in mijn blad plus de datum van vandaag. U kunt echter gemakkelijk meerdere celwaarden doen.

Dit is wat ik heb toegevoegd:
Dim xMemberName als string
Dim xFileDate als string

xMemberName = Bereik ("H3"). Waarde
xFileDate = Formaat (Nu, "mm-dd")

xFolder = xFolder + "\" xMemberName + xFileDate + ".pdf"
Antwoorden
Kishore
Kishore
Deze opmerking is gemaakt door de moderator op de site
Hallo Kristal,



Het is echt geweldig en werkt perfect voor mij. Meer hulp nodig om toe te voegen:

1. in "Body" wil ik een link geven naar een bepaalde cel van het actieve blad. Verder Zou de tekst vet willen maken.

Bedankt

Met vriendelijke groet

Kishore Kumar
Antwoorden
Rapport
crystal
crystal     Kishore
Deze opmerking is gemaakt door de moderator op de site
Hoi,

Bedoel je om de celwaarde automatisch toe te voegen aan de mailbody en deze vetgedrukt te maken? Stel dat u de waarde van C4 toevoegt aan de e-mailtekst. Gelieve onderstaande code toe te passen.

Sub Saveaspdfandsend()

Dim xSht als werkblad

Dim xFileDlg As FileDialog

Dim xFolder als string

Dim xJaofNee Als geheel getal

Dim xOutlookObj als object

Dim xEmailObj als object

Dim xUsedRng As Range



Stel xSht = ActiveSheet in

Stel xFileDlg = Application.FileDialog (msoFileDialogFolderPicker) in



Als xFileDlg.Show = True Dan

xFolder = xFileDlg.SelectedItems(1)

Anders

MsgBox "U moet een map specificeren om de PDF in op te slaan." & vbCrLf & vbCrLf & "Druk op OK om deze macro af te sluiten.", vbCritical, "Moet de doelmap opgeven"

Exit Sub

End If

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



'Controleer of het bestand al bestaat

Als Len(Dir(xFolder)) > 0 Dan

xYesorNo = MsgBox(xFolder & " bestaat al." & vbCrLf & vbCrLf & "Wilt u het overschrijven?", _

vbJaNee + vbVraag, "Bestand bestaat")

On Error Resume Next

Als xJaofNee = vbJa Dan

Kill xFolder

Anders

MsgBox "Als u de bestaande PDF niet overschrijft, kan ik niet verder." _

& vbCrLf & vbCrLf & "Druk op OK om deze macro af te sluiten.", vbCritical, "Macro afsluiten"

Exit Sub

End If

Als Foutnummer <> 0 Dan

MsgBox "Kan het bestaande bestand niet verwijderen. Controleer of het bestand niet geopend of tegen schrijven is beveiligd." _

& vbCrLf & vbCrLf & "Druk op OK om deze macro af te sluiten.", vbCritical, "Kan bestand niet verwijderen"

Exit Sub

End If

End If



Stel xUsedRng = xSht.UsedRange in

If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Dan

'Opslaan als pdf-bestand'

xSht.ExportAsFixedFormat Type:=xlTypePDF, Bestandsnaam:=xFolder, Kwaliteit:=xlQualityStandard



'Maak Outlook e-mail aan'

Stel xOutlookObj = CreateObject ("Outlook.Application") in

Stel xEmailObj = xOutlookObj.CreateItem(0) in

Met xEmailObj

.Scherm

.Naar = ""

.CC = ""

.Onderwerp = xSht.Naam + ".pdf"

.Bijlagen.Toevoegen xFolder

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

Als DisplayEmail = False Dan

'.Versturen

End If

Eindigt met

Anders

MsgBox "Het actieve werkblad mag niet leeg zijn"

Exit Sub

End If

End Sub
Antwoorden
Rapport
Geoff
Geoff
Deze opmerking is gemaakt door de moderator op de site
Als ik zou willen dat het elke keer automatisch in een specifieke map wordt opgeslagen (waardoor de gebruiker de map niet meer hoeft te kiezen), hoe zou ik dat dan doen?
Ex. C: Facturen/Noord-Amerika/Klanten
Hulp wordt zeer gewaardeerd.
Antwoorden
crystal
crystal     Geoff
Deze opmerking is gemaakt door de moderator op de site
Hallo Geoff,
Bedoel je het werkblad opslaan als een pdf-bestand en opslaan in een specifieke map zonder te verzenden?
Antwoorden
Rapport
Jeremy
Jeremy     crystal
Deze opmerking is gemaakt door de moderator op de site
Ik denk dat Geoff betekent dat je elke keer een specifieke map kunt specificeren in de code waarin de pdf wordt opgeslagen, in plaats van de locatie handmatig te moeten selecteren. De pdf wordt vervolgens vanuit die specifieke map gemaild.
Antwoorden
crystal
crystal     Jeremy
Deze opmerking is gemaakt door de moderator op de site
Bedankt Jeremy.
Antwoorden
Rapport
crystal
crystal     Geoff
Deze opmerking is gemaakt door de moderator op de site
Hallo Geoff, Als je het pdf-bestand automatisch in een specifieke map wilt opslaan in plaats van de locatie handmatig te selecteren, probeer dan de onderstaande code. Vergeet niet het mappad in de code te wijzigen.
Sub Opslaan als PDF en verzenden ()
Dim xSht als werkblad
Dim xFileDlg As FileDialog
Dim xFolder als string
Dim xJaofNee Als geheel getal
Dim xOutlookObj als object
Dim xEmailObj als object
Dim xUsedRng As Range
Dim xPath als string
Stel xSht = ActiveSheet in
xPad = "C:\Users\Win10x64Test\Desktop\werkblad naar pdf" 'hier is "werkblad naar pdf" de doelmap om de pdf-bestanden op te slaan
xFolder = xPath + "\" + xSht.Name + ".pdf"
Als Len(Dir(xFolder)) > 0 Dan
xYesorNo = MsgBox(xFolder & " bestaat al." & vbCrLf & vbCrLf & "Wilt u het overschrijven?", _
vbJaNee + vbVraag, "Bestand bestaat")
On Error Resume Next
Als xJaofNee = vbJa Dan
Kill xFolder
Anders
MsgBox "Als u de bestaande PDF niet overschrijft, kan ik niet verder." _
& vbCrLf & vbCrLf & "Druk op OK om deze macro af te sluiten.", vbCritical, "Macro afsluiten"
Exit Sub
End If
Als Foutnummer <> 0 Dan
MsgBox "Kan het bestaande bestand niet verwijderen. Controleer of het bestand niet geopend of tegen schrijven is beveiligd." _
& vbCrLf & vbCrLf & "Druk op OK om deze macro af te sluiten.", vbCritical, "Kan bestand niet verwijderen"
Exit Sub
End If
End If

Stel xUsedRng = xSht.UsedRange in
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Dan
'Opslaan als pdf-bestand'
xSht.ExportAsFixedFormat Type:=xlTypePDF, Bestandsnaam:=xFolder, Kwaliteit:=xlQualityStandard

'Maak Outlook e-mail aan'
Stel xOutlookObj = CreateObject ("Outlook.Application") in
Stel xEmailObj = xOutlookObj.CreateItem(0) in
Met xEmailObj
.Scherm
.Naar = ""
.CC = ""
.Onderwerp = xSht.Naam + ".pdf"
.Bijlagen.Toevoegen xFolder
Als DisplayEmail = False Dan
'.Versturen
End If
Eindigt met
Anders
MsgBox "Het actieve werkblad mag niet leeg zijn"
Exit Sub
End If
End Sub
Antwoorden
Rapport
Alison
Alison
Deze opmerking is gemaakt door de moderator op de site
Deze code werkt prima, behalve dat ik het werkblad wil opslaan als bladnaam + datum (bijv. Blad1 1 oktober 2020); op het bureaublad van de gebruiker (dit wordt door meerdere mensen gebruikt en hun paden kunnen enigszins verschillen). Indien mogelijk wil ik ook een .jpg in de body insluiten.. de JPG bevindt zich zowel binnen het werkblad (buiten het afdrukgebied) als de afbeelding wordt opgeslagen op een gedeelde server.. hoewel het pad naar de server per gebruiker (voor de meesten is het een "T"-schijf, voor sommigen een "U" -schijf)
kan dit? alsjeblieft en bedankt een miljoen keer.
Antwoorden
Deepak
Deepak
Deze opmerking is gemaakt door de moderator op de site

Hallo, het werkt prima, bedankt voor het delen, ik heb maar één hulp nodig.
Als ik een PDF-bestand wil opslaan met een aangepaste naam (optie om bestandsnaam te typen in het dialoogvenster OpslaanAls), gebruik dan deze optie als gebruiker in een formuliersjabloon waar formulieren zijn opgeslagen als PDF met een unieke naam.
Antwoorden
Rapport
crystal
crystal     Deepak
Deze opmerking is gemaakt door de moderator op de site
Hallo, probeer de onderstaande VBA-code. Nadat u de code hebt uitgevoerd, selecteert u een map om het PDF-bestand op te slaan, waarna een dialoogvenster verschijnt waarin u de bestandsnaam kunt invoeren. Sub Saveaspdfandsend()
'Bijgewerkt door' Extendoffice 20210209
Dim xSht als werkblad
Dim xFileDlg As FileDialog
Dim xFolder als string
Dim xJaofNee Als geheel getal
Dim xOutlookObj als object
Dim xEmailObj als object
Dim xUsedRng As Range
Dim xStrName als string
Dim xV Als Variant

Stel xSht = ActiveSheet in
Stel xFileDlg = Application.FileDialog (msoFileDialogFolderPicker) in

Als xFileDlg.Show = True Dan
xFolder = xFileDlg.SelectedItems(1)
Anders
MsgBox "U moet een map specificeren om de PDF in op te slaan." & vbCrLf & vbCrLf & "Druk op OK om deze macro af te sluiten.", vbCritical, "Moet de doelmap opgeven"
Exit Sub
End If
xStrName = ""
xV = Application.InputBox("Voer de bestandsnaam in:", "Kutools for Excel", , , , , , 2)
Als xV = Onwaar Dan
Exit Sub
End If
xStrName = xV
If xStrName = "" Dan
MsgBox ("Geen bestandsnaam ingevoerd, proces afsluiten!")
Exit Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
'Controleer of het bestand al bestaat
Als Len(Dir(xFolder)) > 0 Dan
xYesorNo = MsgBox(xFolder & " bestaat al." & vbCrLf & vbCrLf & "Wilt u het overschrijven?", _
vbJaNee + vbVraag, "Bestand bestaat")
On Error Resume Next
Als xJaofNee = vbJa Dan
Kill xFolder
Anders
MsgBox "Als u de bestaande PDF niet overschrijft, kan ik niet verder." _
& vbCrLf & vbCrLf & "Druk op OK om deze macro af te sluiten.", vbCritical, "Macro afsluiten"
Exit Sub
End If
Als Foutnummer <> 0 Dan
MsgBox "Kan het bestaande bestand niet verwijderen. Controleer of het bestand niet geopend of tegen schrijven is beveiligd." _
& vbCrLf & vbCrLf & "Druk op OK om deze macro af te sluiten.", vbCritical, "Kan bestand niet verwijderen"
Exit Sub
End If
End If

Stel xUsedRng = xSht.UsedRange in
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Dan
'Opslaan als pdf-bestand'
xSht.ExportAsFixedFormat Type:=xlTypePDF, Bestandsnaam:=xFolder, Kwaliteit:=xlQualityStandard

'Maak Outlook e-mail aan'
Stel xOutlookObj = CreateObject ("Outlook.Application") in
Stel xEmailObj = xOutlookObj.CreateItem(0) in
Met xEmailObj
.Scherm
.Naar = ""
.CC = ""
.Onderwerp = xSht.Naam + ".pdf"
.Bijlagen.Toevoegen xFolder
Als DisplayEmail = False Dan
'.Versturen
End If
Eindigt met
Anders
MsgBox "Het actieve werkblad mag niet leeg zijn"
Exit Sub
End If
End Sub
Antwoorden
Rapport
mleczus94
mleczus94
Deze opmerking is gemaakt door de moderator op de site
Hoi,
Als ik twee bladen in een bestand heb en ik wil deze macro op één blad uitvoeren (door op de knop te drukken), maar een ander blad verzenden, hoe kan ik het dan krijgen?
Antwoorden
Rapport
huh
huh
Deze opmerking is gemaakt door de moderator op de site
Hallo, ik wil dit graag opslaan op een bepaalde bestandslocatie, met de naam gebaseerd op de waarde in cel C30. Ik heb een paar opties geprobeerd, maar krijg steeds fouten.
Antwoorden
crystal
crystal     huh
Deze opmerking is gemaakt door de moderator op de site
Hallo hein, De onderstaande code kan misschien helpen. Nadat u de code hebt uitgevoerd, selecteert u een bepaalde map om het PDF-bestand op te slaan, waarna een dialoogvenster verschijnt waarin u de bestandsnaam kunt invoeren. Sub Saveaspdfandsend()
'Bijgewerkt door' Extendoffice 20210209
Dim xSht als werkblad
Dim xFileDlg As FileDialog
Dim xFolder als string
Dim xJaofNee Als geheel getal
Dim xOutlookObj als object
Dim xEmailObj als object
Dim xUsedRng As Range
Dim xStrName als string
Dim xV Als Variant

Stel xSht = ActiveSheet in
Stel xFileDlg = Application.FileDialog (msoFileDialogFolderPicker) in

Als xFileDlg.Show = True Dan
xFolder = xFileDlg.SelectedItems(1)
Anders
MsgBox "U moet een map specificeren om de PDF in op te slaan." & vbCrLf & vbCrLf & "Druk op OK om deze macro af te sluiten.", vbCritical, "Moet de doelmap opgeven"
Exit Sub
End If
xStrName = ""
xV = Application.InputBox("Voer de bestandsnaam in:", "Kutools for Excel", , , , , , 2)
Als xV = Onwaar Dan
Exit Sub
End If
xStrName = xV
If xStrName = "" Dan
MsgBox ("Geen bestandsnaam ingevoerd, proces afsluiten!")
Exit Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
'Controleer of het bestand al bestaat
Als Len(Dir(xFolder)) > 0 Dan
xYesorNo = MsgBox(xFolder & " bestaat al." & vbCrLf & vbCrLf & "Wilt u het overschrijven?", _
vbJaNee + vbVraag, "Bestand bestaat")
On Error Resume Next
Als xJaofNee = vbJa Dan
Kill xFolder
Anders
MsgBox "Als u de bestaande PDF niet overschrijft, kan ik niet verder." _
& vbCrLf & vbCrLf & "Druk op OK om deze macro af te sluiten.", vbCritical, "Macro afsluiten"
Exit Sub
End If
Als Foutnummer <> 0 Dan
MsgBox "Kan het bestaande bestand niet verwijderen. Controleer of het bestand niet geopend of tegen schrijven is beveiligd." _
& vbCrLf & vbCrLf & "Druk op OK om deze macro af te sluiten.", vbCritical, "Kan bestand niet verwijderen"
Exit Sub
End If
End If

Stel xUsedRng = xSht.UsedRange in
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Dan
'Opslaan als pdf-bestand'
xSht.ExportAsFixedFormat Type:=xlTypePDF, Bestandsnaam:=xFolder, Kwaliteit:=xlQualityStandard

'Maak Outlook e-mail aan'
Stel xOutlookObj = CreateObject ("Outlook.Application") in
Stel xEmailObj = xOutlookObj.CreateItem(0) in
Met xEmailObj
.Scherm
.Naar = ""
.CC = ""
.Onderwerp = xSht.Naam + ".pdf"
.Bijlagen.Toevoegen xFolder
Als DisplayEmail = False Dan
'.Versturen
End If
Eindigt met
Anders
MsgBox "Het actieve werkblad mag niet leeg zijn"
Exit Sub
End If
End Sub
Antwoorden
Rapport
Hein
Hein     crystal
Deze opmerking is gemaakt door de moderator op de site
Bedankt daarvoor, dat is geweldig, maar ik wil dat het blad wordt genoemd volgens cel A1 op blad 1. de plaats om op te slaan volgens A1 op blad 2, bijvoorbeeld C:\Users\peete\Dropbox\Screenshots, en e-mail te sturen naar mailadres op A3 blad 2 wat ik al heb uitgewerkt.
Antwoorden
Hein Peeters
Hein Peeters     crystal
Deze opmerking is gemaakt door de moderator op de site
Bedankt daarvoor, dat is geweldig, maar ik wil dat het blad wordt genoemd volgens cel A1 op blad 1. de plaats om op te slaan volgens A1 op blad 2, bijvoorbeeld C:\Users\peete\Dropbox\Screenshots, maar kan veranderen wanneer met behulp van het bestand, en e-mail sturen naar e-mailadres op A3-blad 2 wat ik al heb uitgewerkt.
Antwoorden
Rapport
BenSpo
BenSpo
Deze opmerking is gemaakt door de moderator op de site
Hi crystal , uitstekende code bedankt voor het delen. Is er een manier om meerdere bladen (uit dezelfde werkmap) te selecteren om ze allemaal op te slaan als een onafhankelijke PDF en ze vervolgens allemaal als bijlage in één e-mail te verzenden?
Antwoorden
Rapport
crystal
crystal     BenSpo
Deze opmerking is gemaakt door de moderator op de site
Hallo, de onderstaande VBA-code kan u een plezier doen, probeer het alstublieft. Vervang in de twaalfde regel van de code de bladnamen door de werkelijke bladnamen in uw geval.
Sub Saveaspdfandsend1()
Dim xSht als werkblad
Dim xFileDlg As FileDialog
Dim xFolder als string
Dim xJaofNee, I, xAantal als geheel getal
Dim xOutlookObj als object
Dim xEmailObj als object
Dim xUsedRng As Range
Dim xArrShetts als variant
Dim xPDFNaamAdres als string
Dim xStr As String
xArrShetts = Matrix("test", "Blad1", "Blad2") 'Voer de bladnamen in die u wilt verzenden als pdf-bestanden tussen aanhalingstekens en scheid ze met komma's. Zorg ervoor dat er geen speciale tekens zoals \/:"*<>| in de bestandsnaam staan.

Voor I = 0 Naar UBound(xArrShetts)
On Error Resume Next
Stel xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I)) in
Als xSht.Name <> xArrShetts(I) Dan
MsgBox "Werkblad niet gevonden, bewerking afsluiten:" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
Exit Sub
End If
Volgende


Stel xFileDlg = Application.FileDialog (msoFileDialogFolderPicker) in
Als xFileDlg.Show = True Dan
xFolder = xFileDlg.SelectedItems(1)
Anders
MsgBox "U moet een map specificeren om de PDF in op te slaan." & vbCrLf & vbCrLf & "Druk op OK om deze macro af te sluiten.", vbCritical, "Moet de doelmap opgeven"
Exit Sub
End If
'Controleer of het bestand al bestaat
xYesorNo = MsgBox("Als er bestanden met dezelfde naam in de doelmap staan, wordt het nummerachtervoegsel automatisch aan de bestandsnaam toegevoegd om de duplicaten te onderscheiden" & vbCrLf & vbCrLf & "Klik op Ja om door te gaan, klik op Nee om te annuleren", _
vbJaNee + vbVraag, "Bestand bestaat")
Indien xJaofNee <> vbJa, dan Sub afsluiten
Voor I = 0 Naar UBound(xArrShetts)
Stel xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I)) in

xStr = xFolder & "\" & xSht.Naam & ".pdf"
xGetal = 1
Terwijl niet (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xGetal = xGetal + 1
zich begeven
Stel xUsedRng = xSht.UsedRange in
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Dan
xSht.ExportAsFixedFormat Type:=xlTypePDF, Bestandsnaam:=xStr, Kwaliteit:=xlQualityStandard
Anders

End If
xArrShetts(I) = xStr
Volgende

'Maak Outlook e-mail aan'
Stel xOutlookObj = CreateObject ("Outlook.Application") in
Stel xEmailObj = xOutlookObj.CreateItem(0) in
Met xEmailObj
.Scherm
.Naar = ""
.CC = ""
.Onderwerp = "????"
Voor I = 0 Naar UBound(xArrShetts)
.Bijlagen.Toevoegen xArrShetts(I)
Volgende
Als DisplayEmail = False Dan
'.Versturen
End If
Eindigt met
End Sub
Antwoorden
Rapport
Bernee Rudolph
Bernee Rudolph     crystal
Deze opmerking is gemaakt door de moderator op de site
Hallo, De enige verandering waar ik mee worstel, is om een ​​aparte e-mail te maken voor elk gemaakt pdf-document.
Antwoorden
crystal
crystal     Bernee Rudolph
Deze opmerking is gemaakt door de moderator op de site
Hallo, Als u voor elk pdf-document een aparte e-mail wilt maken, kunt u de VBA in de post handmatig in verschillende werkbladen uitvoeren om het voor elkaar te krijgen.
Antwoorden
Rapport
Bernee Rudolph
Bernee Rudolph     crystal
Deze opmerking is gemaakt door de moderator op de site
Ik heb meer dan 100 werkbladen in de werkmap, wat dan met zich meebrengt dat ik de VBA meer dan 100 keer moet draaien, wat tijdrovend is.  
Ik ben erin geslaagd mijn werkmap op te splitsen in het meerdere blad en vervolgens kan ik elk werkblad naar een afzonderlijk PDF-document converteren.
De oplossing die ik zoek, is om elk PDF-document afzonderlijk te e-mailen terwijl het bovenstaande proces wordt uitgevoerd.
Hierbij de VBA die ik momenteel gebruik:
Sub Saveaspdfandsend1()
Dim xSht als werkblad
Dim xFileDlg As FileDialog
Dim xFolder als string
Dim xJaofNee, I, xAantal als geheel getal
Dim xOutlookObj als object
Dim xEmailObj als object
Dim xUsedRng As Range
Dim xArrShetts als variant
Dim xPDFNaamAdres als string
Dim xStr As String
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") 'Voer de bladnamen in die u wilt verzenden als pdf-bestanden tussen aanhalingstekens en scheid ze met komma's. Zorg ervoor dat er geen speciale tekens zoals \/:"*<>| in de bestandsnaam staan.

Voor I = 0 Naar UBound(xArrShetts)
On Error Resume Next
Stel xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I)) in
Als xSht.Name <> xArrShetts(I) Dan
MsgBox "Werkblad niet gevonden, bewerking afsluiten:" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
Exit Sub
End If
Volgende


Stel xFileDlg = Application.FileDialog (msoFileDialogFolderPicker) in
Als xFileDlg.Show = True Dan
xFolder = xFileDlg.SelectedItems(1)
Anders
MsgBox "U moet een map specificeren om de PDF in op te slaan." & vbCrLf & vbCrLf & "Druk op OK om deze macro af te sluiten.", vbCritical, "Moet de doelmap opgeven"
Exit Sub
End If
'Controleer of het bestand al bestaat
xYesorNo = MsgBox("Als er bestanden met dezelfde naam in de doelmap staan, wordt het nummerachtervoegsel automatisch aan de bestandsnaam toegevoegd om de duplicaten te onderscheiden" & vbCrLf & vbCrLf & "Klik op Ja om door te gaan, klik op Nee om te annuleren", _
vbJaNee + vbVraag, "Bestand bestaat")
Indien xJaofNee <> vbJa, dan Sub afsluiten
Voor I = 0 Naar UBound(xArrShetts)
Stel xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I)) in

xStr = xFolder & "\" & xSht.Naam & ".pdf"
xGetal = 1
Terwijl niet (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xGetal = xGetal + 1
zich begeven
Stel xUsedRng = xSht.UsedRange in
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Dan
xSht.ExportAsFixedFormat Type:=xlTypePDF, Bestandsnaam:=xStr, Kwaliteit:=xlQualityStandard
Anders

End If
xArrShetts(I) = xStr
Volgende

'Maak Outlook e-mail aan'
Stel xOutlookObj = CreateObject ("Outlook.Application") in
Stel xEmailObj = xOutlookObj.CreateItem(0) in
Met xEmailObj
.Scherm
.To = "Ctracklegal@ctrack.com"
.CC = ""
.Onderwerp = "????"
Voor I = 0 Naar UBound(xArrShetts)
On Error Resume Next
.Bijlagen.Toevoegen xArrShetts(I)
Volgende
Als DisplayEmail = False Dan
.Versturen
Exit Sub
End If
Eindigt met


End Sub
Antwoorden
Tori
Tori
Deze opmerking is gemaakt door de moderator op de site
Hallo @crystal
Dit is fantastisch - het belangrijkste waar ik mee worstel is de bestandsnaam - ik zou graag willen dat de bestandsnaam uit een cel in het werkblad wordt gehaald in plaats van de tabnaam te gebruiken. Ik heb de code al bewerkt om automatisch op te slaan in een opgegeven map, maar ik worstel met de bestandsnaam.
Alle hulp die u kunt bieden, alstublieft?
Antwoorden
crystal
crystal     Tori
Deze opmerking is gemaakt door de moderator op de site
Hallo Tori, als je het PDF-bestand een specifieke celwaarde wilt geven, probeer dan de volgende code. Nadat je de code hebt uitgevoerd en een map hebt geselecteerd om het bestand op te slaan, verschijnt er een ander dialoogvenster, selecteer de cel die je wilt gebruiken de waarde als de naam van het PDF-bestand en klik vervolgens op OK om te voltooien.
Sub Saveaspdfandsend2()
'Bijgewerkt door' Extendoffice 20210521
Dim xSht als werkblad
Dim xFileDlg As FileDialog
Dim xFolder als string
Dim xJaofNee Als geheel getal
Dim xOutlookObj als object
Dim xEmailObj als object
Dim xUsedRng, xRgInser As Range
Dim xB As Boolean
Stel xSht = ActiveSheet in
Stel xFileDlg = Application.FileDialog (msoFileDialogFolderPicker) in

Als xFileDlg.Show = True Dan
xFolder = xFileDlg.SelectedItems(1)
Anders
MsgBox "U moet een map specificeren om de PDF in op te slaan." & vbCrLf & vbCrLf & "Druk op OK om deze macro af te sluiten.", vbCritical, "Moet de doelmap opgeven"
Exit Sub
End If
xB = Waar
On Error Resume Next
terwijl xB
Stel xRgInser = Niets in
Set xRgInser = Application.InputBox ("Selecteer een cel waarvan u de waarde wilt gebruiken om het PDF-bestand een naam te geven:", "Kutools for Excel", , , , , , 8)
Als xRgInser niets is, dan?
MsgBox " Geen cel geselecteerd, verlaat de bewerking! ", vbInformation, "Kutools for Excel"
Exit Sub
End If
If xRgInser.Text = "" Dan
MsgBox " De geselecteerde cel is leeg, selecteer opnieuw! ", vbInformation, "Kutools for Excel"
Anders
xB = Onwaar
End If
zich begeven

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

'Controleer of het bestand al bestaat
Als Len(Dir(xFolder)) > 0 Dan
xYesorNo = MsgBox(xFolder & " bestaat al." & vbCrLf & vbCrLf & "Wilt u het overschrijven?", _
vbJaNee + vbVraag, "Bestand bestaat")
On Error Resume Next
Als xJaofNee = vbJa Dan
Kill xFolder
Anders
MsgBox "Als u de bestaande PDF niet overschrijft, kan ik niet verder." _
& vbCrLf & vbCrLf & "Druk op OK om deze macro af te sluiten.", vbCritical, "Macro afsluiten"
Exit Sub
End If
Als Foutnummer <> 0 Dan
MsgBox "Kan het bestaande bestand niet verwijderen. Controleer of het bestand niet geopend of tegen schrijven is beveiligd." _
& vbCrLf & vbCrLf & "Druk op OK om deze macro af te sluiten.", vbCritical, "Kan bestand niet verwijderen"
Exit Sub
End If
End If

Stel xUsedRng = xSht.UsedRange in
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Dan
'Opslaan als pdf-bestand'
xSht.ExportAsFixedFormat Type:=xlTypePDF, Bestandsnaam:=xFolder, Kwaliteit:=xlQualityStandard

'Maak Outlook e-mail aan'
Stel xOutlookObj = CreateObject ("Outlook.Application") in
Stel xEmailObj = xOutlookObj.CreateItem(0) in
Met xEmailObj
.Scherm
.Naar = ""
.CC = ""
.Onderwerp = xSht.Naam + ".pdf"
.Bijlagen.Toevoegen xFolder
Als DisplayEmail = False Dan
'.Versturen
End If
Eindigt met
Anders
MsgBox "Het actieve werkblad mag niet leeg zijn"
Exit Sub
End If
End Sub
Antwoorden
Rapport
Merknaameuropeanu
Merknaameuropeanu
Deze opmerking is gemaakt door de moderator op de site
Hallo, ik had iets soortgelijks nodig, dus hier is wat ik heb. Het neemt de huidige datum en maakt een nieuwe map met de datumnaam op een specifieke locatie. Het plaatst de pdf op die nieuwe locatie en voegt de pdf vervolgens toe aan een nieuwe e-mail. Werkt als een traktatie. Ik ben maar een beginner, dus neem me niet kwalijk als het eruit ziet als een puinhoop. :D
Sub PDFTOEMAIL()
Dim xSht als werkblad
Dim xFileDlg As FileDialog
Dim xFolder als string
Dim xJaofNee Als geheel getal
Dim xOutlookObj als object
Dim xEmailObj als object
Dim xUsedRng As Range
Dim xPath als string
Dim xOutMsg As String
Dim sFolderName As String, sFolder As String
Dim sFolderPath As String

Stel xSht = ActiveSheet in
xFileDate = Formaat (Nu, "dd-mm-jjjj")
sFolder = "C:" 'hier heb je een hoofdmap
sFolderName = "Weekeinde" + Format(Now, "dd-mm-yyyy") 'map die moet worden aangemaakt in de hoofdmap met de naam Weekeinde en huidige datum
sFolderPath = "C:" & sFolderName 'hoofdmap opnieuw om het nieuwe pad inclusief de nieuwe map te maken
Stel oFSO = CreateObject ("Scripting.FileSystemObject") in
Als oFSO.FolderExists(sFolderPath) Dan
MsgBox "Map bestaat al !" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
Anders
MkDir sMappad
MsgBox "Nieuwe map is aangemaakt !" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
End If
xPath = sFolderPath
xFolder = xPath + "\" + xSht.Name + "_" + xFileDate + ".pdf"
Als Len(Dir(xFolder)) > 0 Dan
xYesorNo = MsgBox(xFolder & " bestaat al." & vbCrLf & vbCrLf & "Wilt u het overschrijven?", _
vbJaNee + vbVraag, "Bestand bestaat")
On Error Resume Next
Als xJaofNee = vbJa Dan
Kill xFolder
Anders
MsgBox "Als u de bestaande PDF niet overschrijft, kan ik niet verder." _
& vbCrLf & vbCrLf & "Druk op OK om deze macro af te sluiten.", vbCritical, "Macro afsluiten"
Exit Sub
End If
Als Foutnummer <> 0 Dan
MsgBox "Kan het bestaande bestand niet verwijderen. Controleer of het bestand niet geopend of tegen schrijven is beveiligd." _
& vbCrLf & vbCrLf & "Druk op OK om deze macro af te sluiten.", vbCritical, "Kan bestand niet verwijderen"
Exit Sub
End If
End If

Stel xUsedRng = xSht.UsedRange in
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Dan
xSht.ExportAsFixedFormat Type:=xlTypePDF, Bestandsnaam:=xFolder, Kwaliteit:=xlQualityStandard
Stel xOutlookObj = CreateObject ("Outlook.Application") in
Stel xEmailObj = xOutlookObj.CreateItem(0) in
xOutMsg = " Gelieve bijgevoegd te vinden Deze e-mail en bijlage zijn automatisch gegenereerd "
'voegt een opmerking toe dat de e-mail automatisch is gegenereerd'

Met xEmailObj
.Scherm
.To = "" 'voeg uw eigen e-mails toe
.CC = ""
.Subject = xSht.Name + " PDF voor weekeinde " + xFileDate + " - Location " ' onderwerp omvat bladnaam, pdf, datum en locatie, dit kan indien nodig worden bewerkt
.Bijlagen.Toevoegen xFolder
.HTMLBody = xOutMsg & .HTMLBody
Als DisplayEmail = False Dan
'.Send <--- Hier als u de apostrof verwijdert, wordt de e-mail automatisch verzonden, dus wees voorzichtig
End If
Eindigt met
Anders
MsgBox "Het actieve werkblad mag niet leeg zijn"
Exit Sub
End If
End Sub
Antwoorden
Rapport
Nicole
Nicole
Deze opmerking is gemaakt door de moderator op de site
Hoe bewerk ik deze code om alleen cellen op te slaan ("a1:r99") om op te slaan als PDF. Ik heb extra dingen aan de zijkanten die ik niet in mijn PDF-document wil.
Sub Saveaspdfandsend()
'Bijgewerkt door' Extendoffice 20210209
Dim xSht als werkblad
Dim xFileDlg As FileDialog
Dim xFolder als string
Dim xJaofNee Als geheel getal
Dim xOutlookObj als object
Dim xEmailObj als object
Dim xUsedRng As Range
Dim xStrName als string
Dim xV Als Variant

Stel xSht = ActiveSheet in
Stel xFileDlg = Application.FileDialog (msoFileDialogFolderPicker) in

Als xFileDlg.Show = True Dan
xFolder = xFileDlg.SelectedItems(1)
Anders
MsgBox "U moet een map specificeren om de PDF in op te slaan." & vbCrLf & vbCrLf & "Druk op OK om deze macro af te sluiten.", vbCritical, "Moet de doelmap opgeven"
Exit Sub
End If
xStrName = ""
xV = Application.InputBox("Voer de bestandsnaam in:", "Kutools for Excel", , , , , , 2)
Als xV = Onwaar Dan
Exit Sub
End If
xStrName = xV
If xStrName = "" Dan
MsgBox ("Geen bestandsnaam ingevoerd, proces afsluiten!")
Exit Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
'Controleer of het bestand al bestaat
Als Len(Dir(xFolder)) > 0 Dan
xYesorNo = MsgBox(xFolder & " bestaat al." & vbCrLf & vbCrLf & "Wilt u het overschrijven?", _
vbJaNee + vbVraag, "Bestand bestaat")
On Error Resume Next
Als xJaofNee = vbJa Dan
Kill xFolder
Anders
MsgBox "Als u de bestaande PDF niet overschrijft, kan ik niet verder." _
& vbCrLf & vbCrLf & "Druk op OK om deze macro af te sluiten.", vbCritical, "Macro afsluiten"
Exit Sub
End If
Als Foutnummer <> 0 Dan
MsgBox "Kan het bestaande bestand niet verwijderen. Controleer of het bestand niet geopend of tegen schrijven is beveiligd." _
& vbCrLf & vbCrLf & "Druk op OK om deze macro af te sluiten.", vbCritical, "Kan bestand niet verwijderen"
Exit Sub
End If
End If

Stel xUsedRng = xSht.UsedRange in
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Dan
'Opslaan als pdf-bestand'
xSht.ExportAsFixedFormat Type:=xlTypePDF, Bestandsnaam:=xFolder, Kwaliteit:=xlQualityStandard

'Maak Outlook e-mail aan'
Stel xOutlookObj = CreateObject ("Outlook.Application") in
Stel xEmailObj = xOutlookObj.CreateItem(0) in
Met xEmailObj
.Scherm
.Naar = ""
.CC = ""
.Onderwerp = xSht.Naam + ".pdf"
.Bijlagen.Toevoegen xFolder
Als DisplayEmail = False Dan
'.Versturen
End If
Eindigt met
Anders
MsgBox "Het actieve werkblad mag niet leeg zijn"
Exit Sub
End If
End Sub
Antwoorden
RLF
RLF     Nicole
Deze opmerking is gemaakt door de moderator op de site
Hallo, ik heb zojuist deze code op een van mijn werkbladen geprobeerd en ik heb afdrukgebieden ingesteld zodat de extra dingen onderaan niet in de pdf verschenen. Probeer het!
Antwoorden
Rod Bennett
Rod Bennett
Deze opmerking is gemaakt door de moderator op de site
Hi
Hartelijk dank voor de code, maar is het mogelijk om de PDF automatisch op dezelfde locatie op te slaan als het actieve Excel-bestand en met dezelfde bestandsnaam als het actieve Excel-bestand?
Veel dank.
Staaf
Antwoorden
Er zijn nog geen reacties geplaatst
Laad meer
Laat uw commentaar
Gast
Posten als gast
Inloggen
×
Beoordeel dit bericht:
Reset
0  Personages
Voorgestelde locaties