Note: The other languages of the website are Google-translated. Back to English
Log på Tilmeld

Hvordan gemmes et regneark som PDF-fil og e-mailes som en vedhæftet fil via Outlook?

I nogle tilfælde skal du muligvis sende et regneark som en PDF-fil gennem Outlook. Normalt skal du manuelt gemme regnearket som en PDF-fil og derefter oprette en ny e-mail med denne PDF-fil som vedhæftet fil i din Outlook og endelig sende den. Det er tidskrævende at opnå det manuelt trin for trin. I denne artikel viser vi dig, hvordan du hurtigt gemmer et regneark som en PDF-fil og sender det automatisk som en vedhæftet fil gennem Outlook i Excel.

Gem et regneark som PDF-fil og mail det som en vedhæftet fil med VBA-kode

Gem et regneark som PDF-fil og mail det som en vedhæftet fil med VBA-kode

Du kan køre nedenstående VBA-kode for automatisk at gemme aktivt regneark som en PDF-fil og derefter e-maile det som en vedhæftet fil via Outlook. Gør som følger.

1. Åbn det regneark, du vil gemme som PDF og sende, og tryk derefter på andre + F11 taster samtidigt for at åbne Microsoft Visual Basic til applikationer vindue.

2. i Microsoft Visual Basic til applikationer vindue, skal du klikke på indsatte > Moduler. Kopier og indsæt derefter nedenstående VBA-kode i Kode vindue. Se skærmbillede:

VBA-kode: Gem et regneark som PDF-fil og mail det som en vedhæftet fil

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. Tryk på F5 nøgle for at køre koden. I Gennemse i dialogboksen skal du vælge en mappe for at gemme denne PDF-fil og derefter klikke på OK .

Noter:

1. Nu gemmes det aktive regneark som PDF-fil. Og PDF-filen er navngivet med regnearkets navn.
2. Hvis det aktive regneark er tomt, får du en dialogboks som vist nedenfor, når du har klikket på OK .

4. Nu oprettes en ny Outlook-e-mail, og du kan se, at PDF-filen er angivet som en vedhæftet fil i den vedhæftede fil. Se skærmbillede:

5. Skriv venligst denne e-mail, og send den derefter.
6. Denne kode er kun tilgængelig, når du bruger Outlook som dit mailprogram.

Gem nemt et regneark eller flere regneark som separate PDF-filer på én gang:

Opdelt arbejdsbog nytte af Kutools til Excel kan hjælpe dig med let at gemme et regneark eller flere regneark som separate PDF-filer på én gang som vist nedenfor. Download og prøv det nu! (30-dages gratis sti)

Relaterede artikler:

De bedste Office-produktivitetsværktøjer

Kutools til Excel løser de fleste af dine problemer og øger din produktivitet med 80%

  • Genbruge: Indsæt hurtigt komplekse formler, diagrammer og alt, hvad du har brugt før; Krypter celler med adgangskode Opret postliste og send e-mails ...
  • Super formel bar (let redigere flere linjer med tekst og formel); Læsning Layout (let at læse og redigere et stort antal celler); Indsæt til filtreret rækkevidde...
  • Flet celler / rækker / kolonner uden at miste data; Split celler indhold; Kombiner duplikerede rækker / kolonner... Forhindre duplikerede celler; Sammenlign områder...
  • Vælg Duplicate eller Unique Rækker; Vælg tomme rækker (alle celler er tomme); Super Find og Fuzzy Find i mange arbejdsbøger; Tilfældig valg ...
  • Præcis kopi Flere celler uden at ændre formelreference; Auto Opret referencer til flere ark; Indsæt kugler, Afkrydsningsfelter og mere ...
  • Uddrag tekst, Tilføj tekst, Fjern efter position, Fjern mellemrum; Opret og udskriv personsøgningssubtotaler; Konverter mellem celler indhold og kommentarer...
  • Superfilter (gem og anvend filterskemaer på andre ark); Avanceret sortering efter måned / uge / dag, hyppighed og mere; Specielt filter af fed, kursiv ...
  • Kombiner arbejdsbøger og arbejdsark; Fletabeller baseret på nøglekolonner; Opdel data i flere ark; Batch Konverter xls, xlsx og PDF...
  • Mere end 300 kraftfulde funktioner. Understøtter Office / Excel 2007-2021 og 365. Understøtter alle sprog. Nem implementering i din virksomhed eller organisation. Fuld funktioner 30-dages gratis prøveperiode. 60 dages pengene tilbage garanti.
kte-fane 201905

Fanen Office bringer en grænseflade til et kontor med Office, og gør dit arbejde meget lettere

  • Aktiver redigering og læsning af faner i Word, Excel, PowerPoint, Publisher, Access, Visio og Project.
  • Åbn og opret flere dokumenter i nye faner i det samme vindue snarere end i nye vinduer.
  • Øger din produktivitet med 50 % og reducerer hundredvis af museklik for dig hver dag!
officetab bund
Sorter kommentarer efter
Ældste først
Nyeste først
Kommentarer (62)
Bedømt 5 ud af 5 · 1 vurderinger
Michael
Michael
Denne kommentar blev minimeret af moderatoren på webstedet
Dette fungerer godt for mig, men er der en måde at vælge en mappeplacering automatisk i stedet for at vælge manuelt? Jeg håber at gøre dette for 40 ark på én gang.
Svar
0
0
Hugh
Hugh     Michael
Denne kommentar blev minimeret af moderatoren på webstedet
Håber også at se et svar på dette problem! Tak for hjælpen!
Svar
0
0
Darren
Darren
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg har prøvet at indsætte dette i et nyt modul, og jeg får kompileringsfejl: Sub eller Funktion ikke defineret. Hjælp venligst.
Svar
0
0
krystal
krystal     Darren
Denne kommentar blev minimeret af moderatoren på webstedet
Kære Darren,
Hvilken Office-version bruger du?
Svar
Rapport
0
0
Nakia
Nakia     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
Office 360
Svar
0
0
Bill
Bill     Darren
Denne kommentar blev minimeret af moderatoren på webstedet
Samme problem
Svar
0
0
Michael Charry
Michael Charry
Denne kommentar blev minimeret af moderatoren på webstedet
Hvordan vil jeg redigere VBA-scriptet ovenfor, så det tilføjer et dato- og tidsstempel til filnavnet på den måde, at det ikke bliver ved med at overskrive det, der allerede er gemt?
Svar
Rapport
0
0
krystal
krystal     Michael Charry
Denne kommentar blev minimeret af moderatoren på webstedet
Kære Michael,
Kør venligst nedenstående VBA-kode for at løse problemet.

Sub Gemaspdfandsend()
Dim xSht som arbejdsark
Dim xFileDlg Som FileDialog
Dim xFolder Som streng
Dim xYesorNo Som heltal
Dim xOutlookObj som objekt
Dim xEmailObj Som objekt
Dim xUsedRng As Range
Dim xStr As String

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

Hvis xFileDlg.Show = Sand Så
xFolder = xFileDlg.SelectedItems(1)
Else
MsgBox "Du skal angive en mappe at gemme PDF'en i." & vbCrLf & vbCrLf & "Tryk på OK for at afslutte denne makro.", vbCritical, "Must Specific Destination Folder"
Exit Sub
End If
xStr = Format(Nu(), "åååå-mm-dd-tt-mm-ss")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'Tjek, om filen allerede eksisterer
Hvis Len(Dir(xFolder)) > 0 Så
xYesorNo = MsgBox(xFolder & " eksisterer allerede." & vbCrLf & vbCrLf & "Vil du overskrive den?", _
vbYesNo + vbSpørgsmål, "Filen findes")
On Error Resume Next
Hvis xYesorNo = vbYes Then
Dræb xFolder
Else
MsgBox "hvis du ikke overskriver den eksisterende PDF, kan jeg ikke fortsætte." _
& vbCrLf & vbCrLf & "Tryk på OK for at afslutte denne makro.", vbCritical, "Exiting Macro"
Exit Sub
End If
Hvis Err.Number <> 0 Så
MsgBox "Kan ikke slette eksisterende fil. Sørg for, at filen ikke er åben eller skrivebeskyttet." _
& vbCrLf & vbCrLf & "Tryk på OK for at afslutte denne makro.", vbCritical, "Unable to Delete File"
Exit Sub
End If
End If

Indstil xUsedRng = xSht.UsedRange
Hvis Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Så
'Gem som PDF-fil
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filnavn:=xFolder, Kvalitet:=xlQualityStandard

'Opret Outlook-e-mail
Indstil xOutlookObj = CreateObject("Outlook.Application")
Indstil xEmailObj = xOutlookObj.CreateItem(0)
Med xEmailObj
.Skærm
.Til = ""
.CC = ""
.Subject = xSht.Name + "-" + xStr + ".pdf"
.Attachments.Add xFolder
Hvis DisplayEmail = Falsk Så
'.Sende
End If
Slut med
Else
MsgBox "Det aktive regneark må ikke være tomt"
Exit Sub
End If
End Sub
Svar
Rapport
0
0
Parag Somani
Parag Somani     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Crystal,

Det er virkelig godt og fungerer perfekt for mig. Har du brug for mere hjælp til at tilføje:

1. i "Til" vil jeg give et link til en bestemt celle i det aktive ark som vist i CC og i BCC vil jeg gerne tilføje et aktivt arklink
2. I e-mail-brødteksten skal jeg angive noget standardtekst.

Jeg vil være meget fuld til dig for din hjælp.

Tak
Parag
Svar
0
0
krystal
krystal     Parag Somani
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Parag Somani,
Nedenstående VBA-kode kan hjælpe dig. Skift venligst felterne .Til, .CC, .BCC og .Body baseret på dine behov.

Sub Gemaspdfandsend()
Dim xSht som arbejdsark
Dim xFileDlg Som FileDialog
Dim xFolder Som streng
Dim xYesorNo Som heltal
Dim xOutlookObj som objekt
Dim xEmailObj Som objekt
Dim xUsedRng As Range
Dim xStr As String

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

Hvis xFileDlg.Show = Sand Så
xFolder = xFileDlg.SelectedItems(1)
Else
MsgBox "Du skal angive en mappe at gemme PDF'en i." & vbCrLf & vbCrLf & "Tryk på OK for at afslutte denne makro.", vbCritical, "Must Specific Destination Folder"
Exit Sub
End If
xStr = Format(Nu(), "åååå-mm-dd-tt-mm-ss")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'Tjek, om filen allerede eksisterer
Hvis Len(Dir(xFolder)) > 0 Så
xYesorNo = MsgBox(xFolder & " eksisterer allerede." & vbCrLf & vbCrLf & "Vil du overskrive den?", _
vbYesNo + vbSpørgsmål, "Filen findes")
On Error Resume Next
Hvis xYesorNo = vbYes Then
Dræb xFolder
Else
MsgBox "hvis du ikke overskriver den eksisterende PDF, kan jeg ikke fortsætte." _
& vbCrLf & vbCrLf & "Tryk på OK for at afslutte denne makro.", vbCritical, "Exiting Macro"
Exit Sub
End If
Hvis Err.Number <> 0 Så
MsgBox "Kan ikke slette eksisterende fil. Sørg for, at filen ikke er åben eller skrivebeskyttet." _
& vbCrLf & vbCrLf & "Tryk på OK for at afslutte denne makro.", vbCritical, "Unable to Delete File"
Exit Sub
End If
End If

Indstil xUsedRng = xSht.UsedRange
Hvis Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Så
'Gem som PDF-fil
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filnavn:=xFolder, Kvalitet:=xlQualityStandard

'Opret Outlook-e-mail
Indstil xOutlookObj = CreateObject("Outlook.Application")
Indstil xEmailObj = xOutlookObj.CreateItem(0)
Med xEmailObj
.Skærm
.To = Range("A8")
.CC = Range("A9")
.BCC = Range("A10")
.Subject = xSht.Name + "-" + xStr + ".pdf"
.Body = "Kære" _
& vbNewLine & vbNewLine & _
"Dette er en test-e-mail" & _
"sende i Excel"
.Attachments.Add xFolder
Hvis DisplayEmail = Falsk Så
'.Sende
End If
Slut med
Else
MsgBox "Det aktive regneark må ikke være tomt"
Exit Sub
End If
End Sub
Svar
Rapport
0
0
Mehul
Mehul     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg har forsøgt at bruge området til "Til", "CC", det opfanger bare ikke værdierne fra den udpegede celle. Kan du venligst hjælpe med dette?
Tak,
Mehul
Svar
0
0
Parag Somani
Parag Somani     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Crystal,

Det er virkelig godt og fungerer perfekt for mig. Har du brug for mere hjælp til at tilføje:

1. i "Til" vil jeg give et link til en bestemt celle i det aktive ark som vist i CC og i BCC vil jeg gerne tilføje et aktivt arklink
2. I e-mail-brødteksten skal jeg angive noget standardtekst.

Jeg vil være meget fuld til dig for din hjælp.

Tak
Parag
Svar
0
0
Parag
Parag     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Crystal,

Det er virkelig godt og fungerer perfekt for mig. Har du brug for mere hjælp til at tilføje:

1. i "Til" vil jeg give et link til en bestemt celle i det aktive ark som vist i CC og i BCC vil jeg gerne tilføje et aktivt arklink
2. I e-mail-brødteksten skal jeg angive noget standardtekst.

Jeg vil være meget fuld til dig for din hjælp.

Tak
Parag
Svar
Rapport
0
0
Armin
Armin
Denne kommentar blev minimeret af moderatoren på webstedet
Hvordan kan jeg tilføje for eksempel ark 2 fra projektmappen som en pdf?
Svar
0
0
krystal
krystal     Armin
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Armin,
Du skal først åbne ark 2 i din projektmappe og derefter køre VBA-koden med ovenstående trin for at få den ned.
Svar
Rapport
0
0
Tom H
Tom H
Denne kommentar blev minimeret af moderatoren på webstedet
Hvordan vil jeg redigere VBA-scriptet ovenfor, så filnavnet gemmes som en bestemt celle valgt i det aktuelle ark, for eksempel celle A1?
Svar
0
0
krystal
krystal     Tom H
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Tom.
Jeg kan desværre ikke hjælpe med dette.
Velkommen til at stille ethvert spørgsmål i vores forum: https://www.extendoffice.com/forum.html
Du vil få mere Excel-support fra Excel-professionelle eller andre Excel-fans.
Svar
Rapport
0
0
james
james
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, hvordan kan jeg gemme og sende pdf'en med projektmappens navn med den aktuelle VBA-kode? hvad bruger jeg i stedet for xSht.Name
Svar
0
0
krystal
krystal     james
Denne kommentar blev minimeret af moderatoren på webstedet
Hej James,
Vil du sende det aktive regneark som pdf og navngive det som projektmappens navn?
Svar
Rapport
0
0
Ranga
Ranga
Denne kommentar blev minimeret af moderatoren på webstedet
Tak det virker.
Svar
0
0
Jason
Jason
Denne kommentar blev minimeret af moderatoren på webstedet
Hvordan kan jeg få den til at slette den gemte pdf, efter den har sendt den via e-mail?
Svar
0
0
krystal
krystal     Jason
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Jason,
Jeg kan desværre ikke hjælpe dig med det endnu. Du skal manuelt slette den efter at have sendt den via e-mail.
Svar
Rapport
0
0
Odd-Inge
Odd-Inge
Denne kommentar blev minimeret af moderatoren på webstedet
Hej,

Er det muligt at finde navnet på pdf fra en celle? Eks. Celle H4


Og i celle H4 vil jeg have det til at indsamle fra tre forskellige celler. Er dette muligt?
Svar
0
0
Taylor
Taylor     Odd-Inge
Denne kommentar blev minimeret af moderatoren på webstedet
Dette er muligt. Lav separate variabler for at holde værdien fra cellerne, og brug derefter disse variable, når du indstiller xFolder.
Jeg brugte værdien fra en celle i mit ark plus dagens dato. Du kan dog nemt lave flere celleværdier.

Dette er hvad jeg tilføjede:
Dim xMemberName Som streng
Dim xFileDate As String

xMedlemsnavn = Range("H3").Værdi
xFileDate = Format(Nu, "mm-dd")

xFolder = xFolder + "\" xMedlemsnavn + xFileDate + ".pdf"
Svar
0
0
Sora
Sora     Taylor
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg får en fejl, når jeg prøver dette, hvor i koden skal jeg placere dette?
Svar
0
0
Kishore
Kishore
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Crystal,



Det er virkelig godt og fungerer perfekt for mig. Har du brug for mere hjælp til at tilføje:

1. i "Body" vil jeg give link til en bestemt celle i det aktive ark. Yderligere Vil gerne fremhæve teksten med fed skrift.

Tak

Hilsen

Kishore kumar
Svar
Rapport
0
0
krystal
krystal     Kishore
Denne kommentar blev minimeret af moderatoren på webstedet
Hej,

Mener du at tilføje celleværdien automatisk til postteksten og fed den? Hvis du antager, at du tilføjer værdien af ​​C4 til postteksten. Anvend venligst nedenstående kode.

Sub Gemaspdfandsend()

Dim xSht som arbejdsark

Dim xFileDlg Som FileDialog

Dim xFolder Som streng

Dim xYesorNo Som heltal

Dim xOutlookObj som objekt

Dim xEmailObj Som objekt

Dim xUsedRng As Range



Indstil xSht = ActiveSheet

Indstil xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)



Hvis xFileDlg.Show = Sand Så

xFolder = xFileDlg.SelectedItems(1)

Else

MsgBox "Du skal angive en mappe at gemme PDF'en i." & vbCrLf & vbCrLf & "Tryk på OK for at afslutte denne makro.", vbCritical, "Must Specific Destination Folder"

Exit Sub

End If

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



'Tjek, om filen allerede eksisterer

Hvis Len(Dir(xFolder)) > 0 Så

xYesorNo = MsgBox(xFolder & " eksisterer allerede." & vbCrLf & vbCrLf & "Vil du overskrive den?", _

vbYesNo + vbSpørgsmål, "Filen findes")

On Error Resume Next

Hvis xYesorNo = vbYes Then

Dræb xFolder

Else

MsgBox "hvis du ikke overskriver den eksisterende PDF, kan jeg ikke fortsætte." _

& vbCrLf & vbCrLf & "Tryk på OK for at afslutte denne makro.", vbCritical, "Exiting Macro"

Exit Sub

End If

Hvis Err.Number <> 0 Så

MsgBox "Kan ikke slette eksisterende fil. Sørg for, at filen ikke er åben eller skrivebeskyttet." _

& vbCrLf & vbCrLf & "Tryk på OK for at afslutte denne makro.", vbCritical, "Unable to Delete File"

Exit Sub

End If

End If



Indstil xUsedRng = xSht.UsedRange

Hvis Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Så

'Gem som PDF-fil

xSht.ExportAsFixedFormat Type:=xlTypePDF, Filnavn:=xFolder, Kvalitet:=xlQualityStandard



'Opret Outlook-e-mail

Indstil xOutlookObj = CreateObject("Outlook.Application")

Indstil xEmailObj = xOutlookObj.CreateItem(0)

Med xEmailObj

.Skærm

.Til = ""

.CC = ""

.Subject = xSht.Name + ".pdf"

.Attachments.Add xFolder

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

Hvis DisplayEmail = Falsk Så

'.Sende

End If

Slut med

Else

MsgBox "Det aktive regneark må ikke være tomt"

Exit Sub

End If

End Sub
Svar
Rapport
0
0
Geoff
Geoff
Denne kommentar blev minimeret af moderatoren på webstedet
Hvis jeg ønskede, at den automatisk skulle gemme i en bestemt mappe hver gang (hvilket eliminerer behovet for, at brugeren skal vælge mappen), hvordan ville jeg gøre det?
Eks. C: Fakturaer/Nordamerika/Kunder
Hjælp er meget værdsat.
Svar
0
0
krystal
krystal     Geoff
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Geoff,
Mener du gemme regnearket som en pdf-fil og gemme i en bestemt mappe uden at sende?
Svar
Rapport
0
0
Jeremy
Jeremy     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg tror, ​​at Geoff betyder at være i stand til at specificere en specifik mappe i koden, som pdf'en gemmes til hver gang i stedet for at skulle vælge placeringen manuelt. Pdf'en sendes derefter via e-mail fra den specifikke mappe.
Svar
0
0
krystal
krystal     Jeremy
Denne kommentar blev minimeret af moderatoren på webstedet
Tak Jeremy.
Svar
Rapport
0
0
krystal
krystal     Geoff
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Geoff, Hvis du automatisk vil gemme pdf-filen i en bestemt mappe i stedet for at vælge placeringen manuelt, prøv venligst nedenstående kode. Glem ikke at ændre mappestien i koden.
Sub GemAsPDFandSend()
Dim xSht som arbejdsark
Dim xFileDlg Som FileDialog
Dim xFolder Som streng
Dim xYesorNo Som heltal
Dim xOutlookObj som objekt
Dim xEmailObj Som objekt
Dim xUsedRng As Range
Dim xPath som streng
Indstil xSht = ActiveSheet
xPath = "C:\Users\Win10x64Test\Desktop\arbejdsark til pdf" 'her er "arbejdsark til pdf" destinationsmappen til at gemme pdf-filerne
xFolder = xPath + "\" + xSht.Name + ".pdf"
Hvis Len(Dir(xFolder)) > 0 Så
xYesorNo = MsgBox(xFolder & " eksisterer allerede." & vbCrLf & vbCrLf & "Vil du overskrive den?", _
vbYesNo + vbSpørgsmål, "Filen findes")
On Error Resume Next
Hvis xYesorNo = vbYes Then
Dræb xFolder
Else
MsgBox "hvis du ikke overskriver den eksisterende PDF, kan jeg ikke fortsætte." _
& vbCrLf & vbCrLf & "Tryk på OK for at afslutte denne makro.", vbCritical, "Exiting Macro"
Exit Sub
End If
Hvis Err.Number <> 0 Så
MsgBox "Kan ikke slette eksisterende fil. Sørg for, at filen ikke er åben eller skrivebeskyttet." _
& vbCrLf & vbCrLf & "Tryk på OK for at afslutte denne makro.", vbCritical, "Unable to Delete File"
Exit Sub
End If
End If

Indstil xUsedRng = xSht.UsedRange
Hvis Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Så
'Gem som PDF-fil
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filnavn:=xFolder, Kvalitet:=xlQualityStandard

'Opret Outlook-e-mail
Indstil xOutlookObj = CreateObject("Outlook.Application")
Indstil xEmailObj = xOutlookObj.CreateItem(0)
Med xEmailObj
.Skærm
.Til = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Add xFolder
Hvis DisplayEmail = Falsk Så
'.Sende
End If
Slut med
Else
MsgBox "Det aktive regneark må ikke være tomt"
Exit Sub
End If
End Sub
Svar
Rapport
0
0
Alison
Alison
Denne kommentar blev minimeret af moderatoren på webstedet
Denne kode fungerer godt, bortset fra at jeg vil have arbejdsarket gemt som arknavn + dato (dvs. Ark 1. oktober 1 2020); på brugerens skrivebord (dette vil blive brugt af flere personer, og deres veje kan variere lidt). Hvis det er muligt, vil jeg også indlejre en .jpg i brødteksten. JPG'en er placeret både inde i regnearket (uden for printområdet), og billedet er gemt på en delt server. selvom stien til serveren varierer afhængigt af bruger (for de fleste er det et "T"-drev for nogle et "U"-drev)
kan dette lade sig gøre? tak og tak en million gange.
Svar
0
0
Deepak
Deepak
Denne kommentar blev minimeret af moderatoren på webstedet

Hej, det fungerer godt, tak fordi du deler, har bare brug for en hjælp.
Hvis jeg ønsker at gemme en PDF-fil med et tilpasset navn (mulighed for at skrive filnavn i dialogboksen Gem som), skal brugeren bruge denne mulighed i formularskabelonen, hvor formularer gemt som PDF med unikt navn.
Svar
Rapport
0
0
krystal
krystal     Deepak
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, prøv venligst nedenstående VBA-kode. Når du har kørt koden, skal du vælge en mappe for at gemme PDF-filen, hvorefter en dialogboks dukker op, hvor du kan indtaste filnavnet. Sub Gemaspdfandsend()
'Opdateret af Extendoffice 20210209
Dim xSht som arbejdsark
Dim xFileDlg Som FileDialog
Dim xFolder Som streng
Dim xYesorNo Som heltal
Dim xOutlookObj som objekt
Dim xEmailObj Som objekt
Dim xUsedRng As Range
Dim xStrName Som streng
Dim xV Som Variant

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

Hvis xFileDlg.Show = Sand Så
xFolder = xFileDlg.SelectedItems(1)
Else
MsgBox "Du skal angive en mappe at gemme PDF'en i." & vbCrLf & vbCrLf & "Tryk på OK for at afslutte denne makro.", vbCritical, "Must Specific Destination Folder"
Exit Sub
End If
xStrName = ""
xV = Application.InputBox("Indtast venligst filnavnet:", "Kutools for Excel", , , , , , 2)
Hvis xV = Falsk Så
Exit Sub
End If
xStrName = xV
Hvis xStrName = "" Så
MsgBox ("Intet filnavn indtastet, afslutter proces!")
Exit Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
'Tjek, om filen allerede eksisterer
Hvis Len(Dir(xFolder)) > 0 Så
xYesorNo = MsgBox(xFolder & " eksisterer allerede." & vbCrLf & vbCrLf & "Vil du overskrive den?", _
vbYesNo + vbSpørgsmål, "Filen findes")
On Error Resume Next
Hvis xYesorNo = vbYes Then
Dræb xFolder
Else
MsgBox "hvis du ikke overskriver den eksisterende PDF, kan jeg ikke fortsætte." _
& vbCrLf & vbCrLf & "Tryk på OK for at afslutte denne makro.", vbCritical, "Exiting Macro"
Exit Sub
End If
Hvis Err.Number <> 0 Så
MsgBox "Kan ikke slette eksisterende fil. Sørg for, at filen ikke er åben eller skrivebeskyttet." _
& vbCrLf & vbCrLf & "Tryk på OK for at afslutte denne makro.", vbCritical, "Unable to Delete File"
Exit Sub
End If
End If

Indstil xUsedRng = xSht.UsedRange
Hvis Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Så
'Gem som PDF-fil
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filnavn:=xFolder, Kvalitet:=xlQualityStandard

'Opret Outlook-e-mail
Indstil xOutlookObj = CreateObject("Outlook.Application")
Indstil xEmailObj = xOutlookObj.CreateItem(0)
Med xEmailObj
.Skærm
.Til = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Add xFolder
Hvis DisplayEmail = Falsk Så
'.Sende
End If
Slut med
Else
MsgBox "Det aktive regneark må ikke være tomt"
Exit Sub
End If
End Sub
Svar
Rapport
0
0
mleczus94
mleczus94
Denne kommentar blev minimeret af moderatoren på webstedet
Hej,
Hvis jeg har to ark i filen, og jeg gerne vil køre denne makro på ét ark (ved at trykke på knappen), men sende et andet, hvordan kan jeg så få det?
Svar
Rapport
0
0
hva
hva
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, jeg vil gerne gemme dette på en bestemt filplacering, med navnet baseret på værdien i celle C30. Jeg har prøvet et par muligheder, men bliver ved med at få fejl.
Svar
0
0
krystal
krystal     hva
Denne kommentar blev minimeret af moderatoren på webstedet
Hej hein, Nedenstående kode kan måske hjælpe. Når du har kørt koden, skal du vælge en bestemt mappe for at gemme PDF-filen, hvorefter en dialogboks dukker op, hvor du kan indtaste filnavnet. Sub Gemaspdfandsend()
'Opdateret af Extendoffice 20210209
Dim xSht som arbejdsark
Dim xFileDlg Som FileDialog
Dim xFolder Som streng
Dim xYesorNo Som heltal
Dim xOutlookObj som objekt
Dim xEmailObj Som objekt
Dim xUsedRng As Range
Dim xStrName Som streng
Dim xV Som Variant

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

Hvis xFileDlg.Show = Sand Så
xFolder = xFileDlg.SelectedItems(1)
Else
MsgBox "Du skal angive en mappe at gemme PDF'en i." & vbCrLf & vbCrLf & "Tryk på OK for at afslutte denne makro.", vbCritical, "Must Specific Destination Folder"
Exit Sub
End If
xStrName = ""
xV = Application.InputBox("Indtast venligst filnavnet:", "Kutools for Excel", , , , , , 2)
Hvis xV = Falsk Så
Exit Sub
End If
xStrName = xV
Hvis xStrName = "" Så
MsgBox ("Intet filnavn indtastet, afslutter proces!")
Exit Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
'Tjek, om filen allerede eksisterer
Hvis Len(Dir(xFolder)) > 0 Så
xYesorNo = MsgBox(xFolder & " eksisterer allerede." & vbCrLf & vbCrLf & "Vil du overskrive den?", _
vbYesNo + vbSpørgsmål, "Filen findes")
On Error Resume Next
Hvis xYesorNo = vbYes Then
Dræb xFolder
Else
MsgBox "hvis du ikke overskriver den eksisterende PDF, kan jeg ikke fortsætte." _
& vbCrLf & vbCrLf & "Tryk på OK for at afslutte denne makro.", vbCritical, "Exiting Macro"
Exit Sub
End If
Hvis Err.Number <> 0 Så
MsgBox "Kan ikke slette eksisterende fil. Sørg for, at filen ikke er åben eller skrivebeskyttet." _
& vbCrLf & vbCrLf & "Tryk på OK for at afslutte denne makro.", vbCritical, "Unable to Delete File"
Exit Sub
End If
End If

Indstil xUsedRng = xSht.UsedRange
Hvis Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Så
'Gem som PDF-fil
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filnavn:=xFolder, Kvalitet:=xlQualityStandard

'Opret Outlook-e-mail
Indstil xOutlookObj = CreateObject("Outlook.Application")
Indstil xEmailObj = xOutlookObj.CreateItem(0)
Med xEmailObj
.Skærm
.Til = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Add xFolder
Hvis DisplayEmail = Falsk Så
'.Sende
End If
Slut med
Else
MsgBox "Det aktive regneark må ikke være tomt"
Exit Sub
End If
End Sub
Svar
Rapport
0
0
Hein
Hein     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
Tak for det, det er fantastisk, men jeg vil have, at arket skal navngives i henhold til celle A1 på ark 1. stedet for at gemme i henhold til A1 på ark 2, for eksempel C:\Users\peete\Dropbox\Screenshots, og e-mail sendes til e-mailadresse på A3 ark 2, hvad jeg allerede har udarbejdet.
Svar
0
0
HeinPeeters
HeinPeeters     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
Tak for det, det er godt, men jeg vil have, at arket skal navngives i henhold til celle A1 på ark 1. stedet for at gemme i henhold til A1 på ark 2, for eksempel C:\Users\peete\Dropbox\Screenshots, men kan ændres, når ved at bruge filen, og e-mail sende til e-mailadresse på A3 ark 2, hvad jeg allerede har udarbejdet.
Svar
Rapport
0
0
BenSpo
BenSpo
Denne kommentar blev minimeret af moderatoren på webstedet
Hi krystal , fremragende kode tak for deling. Er der en måde at vælge flere ark (fra den samme projektmappe) for at gemme hver enkelt som en uafhængig PDF og derefter sende dem alle vedhæftet i én e-mail?
Svar
Rapport
0
0
krystal
krystal     BenSpo
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, VBA-koden nedenfor kan gøre dig en tjeneste, prøv venligst. I den tolvte linje i koden skal du erstatte arknavnene med de faktiske arknavne i dit tilfælde.
Sub Gemaspdfandsend1()
Dim xSht som arbejdsark
Dim xFileDlg Som FileDialog
Dim xFolder Som streng
Dim xJa eller Nej, I, xNum Som heltal
Dim xOutlookObj som objekt
Dim xEmailObj Som objekt
Dim xUsedRng As Range
Dim xArrShetts som variant
Dim xPDFNameAddress As String
Dim xStr As String
xArrShetts = Array("prøve", "Ark1", "Ark2") 'Indtast de arknavne, du vil sende som pdf-filer med anførselstegn, og adskil dem med komma. Sørg for, at der ikke er nogen specialtegn såsom \/:"*<>| i filnavnet.

For I = 0 Til UBound(xArrShetts)
On Error Resume Next
Indstil xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))
Hvis xSht.Name <> xArrShetts(I) Så
MsgBox "Arbejdsark blev ikke fundet, afslut operation:" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
Exit Sub
End If
Næste


Indstil xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
Hvis xFileDlg.Show = Sand Så
xFolder = xFileDlg.SelectedItems(1)
Else
MsgBox "Du skal angive en mappe at gemme PDF'en i." & vbCrLf & vbCrLf & "Tryk på OK for at afslutte denne makro.", vbCritical, "Must Specific Destination Folder"
Exit Sub
End If
'Tjek, om filen allerede eksisterer
xYesorNo = MsgBox("Hvis filer med samme navn findes i destinationsmappen, tilføjes nummersuffikset automatisk til filnavnet for at skelne mellem dubletterne" & vbCrLf & vbCrLf & "Klik Ja for at fortsætte, klik på Nej for at annullere", _
vbYesNo + vbSpørgsmål, "Filen findes")
Hvis xJa eller Nej <> vbJa Afslut Sub
For I = 0 Til UBound(xArrShetts)
Indstil xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
xNum = 1
Mens ikke (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xNum = xNum + 1
Wend
Indstil xUsedRng = xSht.UsedRange
Hvis Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Så
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filnavn:=xStr, Kvalitet:=xlQualityStandard
Else

End If
xArrShetts(I) = xStr
Næste

'Opret Outlook-e-mail
Indstil xOutlookObj = CreateObject("Outlook.Application")
Indstil xEmailObj = xOutlookObj.CreateItem(0)
Med xEmailObj
.Skærm
.Til = ""
.CC = ""
.Subject = "????"
For I = 0 Til UBound(xArrShetts)
.Attachments.Add xArrShetts(I)
Næste
Hvis DisplayEmail = Falsk Så
'.Sende
End If
Slut med
End Sub
Svar
Rapport
0
0
Bernee Rudolph
Bernee Rudolph     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, Den ene ændring, jeg kæmper med, er at oprette en separat e-mail for hvert oprettet pdf-dokument.
Svar
0
0
krystal
krystal     Bernee Rudolph
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, For at oprette en separat e-mail for hvert pdf-dokument kan du manuelt køre den VBA, der er angivet i indlægget i forskellige regneark for at få det gjort.
Svar
Rapport
0
0
Bernee Rudolph
Bernee Rudolph     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg har mere end 100 arbejdsark i projektmappen, hvilket vil medføre, at jeg skal køre VBA'en mere end 100 gange, hvilket er tidskrævende.  
Jeg har formået at opdele min projektmappe i flere ark, og så er jeg i stand til at konvertere hvert regneark til et individuelt PDF-dokument.
Den løsning, jeg leder efter, er at e-maile hvert PDF-dokument separat, mens ovenstående proces kører.
Hermed den VBA, jeg kører i øjeblikket:
Sub Gemaspdfandsend1()
Dim xSht som arbejdsark
Dim xFileDlg Som FileDialog
Dim xFolder Som streng
Dim xJa eller Nej, I, xNum Som heltal
Dim xOutlookObj som objekt
Dim xEmailObj Som objekt
Dim xUsedRng As Range
Dim xArrShetts som variant
Dim xPDFNameAddress As 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") 'Indtast de arknavne, du vil sende som pdf-filer med anførselstegn, og adskil dem med komma. Sørg for, at der ikke er nogen specialtegn såsom \/:"*<>| i filnavnet.

For I = 0 Til UBound(xArrShetts)
On Error Resume Next
Indstil xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))
Hvis xSht.Name <> xArrShetts(I) Så
MsgBox "Arbejdsark blev ikke fundet, afslut operation:" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
Exit Sub
End If
Næste


Indstil xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
Hvis xFileDlg.Show = Sand Så
xFolder = xFileDlg.SelectedItems(1)
Else
MsgBox "Du skal angive en mappe at gemme PDF'en i." & vbCrLf & vbCrLf & "Tryk på OK for at afslutte denne makro.", vbCritical, "Must Specific Destination Folder"
Exit Sub
End If
'Tjek, om filen allerede eksisterer
xYesorNo = MsgBox("Hvis filer med samme navn findes i destinationsmappen, tilføjes nummersuffikset automatisk til filnavnet for at skelne mellem dubletterne" & vbCrLf & vbCrLf & "Klik Ja for at fortsætte, klik på Nej for at annullere", _
vbYesNo + vbSpørgsmål, "Filen findes")
Hvis xJa eller Nej <> vbJa Afslut Sub
For I = 0 Til UBound(xArrShetts)
Indstil xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
xNum = 1
Mens ikke (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xNum = xNum + 1
Wend
Indstil xUsedRng = xSht.UsedRange
Hvis Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Så
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filnavn:=xStr, Kvalitet:=xlQualityStandard
Else

End If
xArrShetts(I) = xStr
Næste

'Opret Outlook-e-mail
Indstil xOutlookObj = CreateObject("Outlook.Application")
Indstil xEmailObj = xOutlookObj.CreateItem(0)
Med xEmailObj
.Skærm
.To = "Ctracklegal@ctrack.com"
.CC = ""
.Subject = "????"
For I = 0 Til UBound(xArrShetts)
On Error Resume Next
.Attachments.Add xArrShetts(I)
Næste
Hvis DisplayEmail = Falsk Så
.Sende
Exit Sub
End If
Slut med


End Sub
Svar
0
0
Tori
Tori
Denne kommentar blev minimeret af moderatoren på webstedet
Hej @crystal
Det her er fantastisk - den vigtigste ting, jeg kæmper med, er filnavnet - jeg vil gerne have filnavnet til at hente fra en celle i regnearket i stedet for at bruge fanenavnet. Jeg har allerede redigeret koden til automatisk at gemme i en bestemt mappe, men jeg kæmper med filnavnet.
Nogen hjælp du kan tilbyde?
Svar
0
0
krystal
krystal     Tori
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Tori, Hvis du vil navngive PDF-filen med en specifik celleværdi, prøv venligst følgende kode. Efter at have kørt koden og valgt en mappe til at gemme filen, dukker en anden dialogboks op, vælg venligst den celle du vil bruge værdien som navnet på PDF-filen, og klik derefter på OK for at afslutte.
Sub Gemaspdfandsend2()
'Opdateret af Extendoffice 20210521
Dim xSht som arbejdsark
Dim xFileDlg Som FileDialog
Dim xFolder Som streng
Dim xYesorNo Som heltal
Dim xOutlookObj som objekt
Dim xEmailObj Som objekt
Dim xUsedRng, xRgInser As Range
Dim xB Som Boolean
Indstil xSht = ActiveSheet
Indstil xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Hvis xFileDlg.Show = Sand Så
xFolder = xFileDlg.SelectedItems(1)
Else
MsgBox "Du skal angive en mappe at gemme PDF'en i." & vbCrLf & vbCrLf & "Tryk på OK for at afslutte denne makro.", vbCritical, "Must Specific Destination Folder"
Exit Sub
End If
xB = Sandt
On Error Resume Next
Mens xB
Indstil xRgInser = Intet
Indstil xRgInser = Application.InputBox("Vælg en celle, som du vil bruge værdien til at navngive PDF-filen:", "Kutools for Excel", , , , , , 8)
Hvis xRgInser ikke er noget, så
MsgBox " Ingen celle valgt, forlad operationen! ", vbInformation, "Kutools for Excel"
Exit Sub
End If
Hvis xRgInser.Text = "" Så
MsgBox " Den valgte celle er tom, vælg venligst igen! ", vbInformation, "Kutools for Excel"
Else
xB = Falsk
End If
Wend

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

'Tjek, om filen allerede eksisterer
Hvis Len(Dir(xFolder)) > 0 Så
xYesorNo = MsgBox(xFolder & " eksisterer allerede." & vbCrLf & vbCrLf & "Vil du overskrive den?", _
vbYesNo + vbSpørgsmål, "Filen findes")
On Error Resume Next
Hvis xYesorNo = vbYes Then
Dræb xFolder
Else
MsgBox "hvis du ikke overskriver den eksisterende PDF, kan jeg ikke fortsætte." _
& vbCrLf & vbCrLf & "Tryk på OK for at afslutte denne makro.", vbCritical, "Exiting Macro"
Exit Sub
End If
Hvis Err.Number <> 0 Så
MsgBox "Kan ikke slette eksisterende fil. Sørg for, at filen ikke er åben eller skrivebeskyttet." _
& vbCrLf & vbCrLf & "Tryk på OK for at afslutte denne makro.", vbCritical, "Unable to Delete File"
Exit Sub
End If
End If

Indstil xUsedRng = xSht.UsedRange
Hvis Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Så
'Gem som PDF-fil
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filnavn:=xFolder, Kvalitet:=xlQualityStandard

'Opret Outlook-e-mail
Indstil xOutlookObj = CreateObject("Outlook.Application")
Indstil xEmailObj = xOutlookObj.CreateItem(0)
Med xEmailObj
.Skærm
.Til = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Add xFolder
Hvis DisplayEmail = Falsk Så
'.Sende
End If
Slut med
Else
MsgBox "Det aktive regneark må ikke være tomt"
Exit Sub
End If
End Sub
Svar
Rapport
0
0
Gør europæisk
Gør europæisk
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, jeg havde brug for noget lignende, så her er hvad jeg fik. Det tager den nuværende dato og opretter en ny mappe med datonavnet på en bestemt placering. Den placerer pdf'en inde i den nye placering og vedhæfter derefter pdf'en til en ny e-mail. Virker som en godbid. Jeg er kun nybegynder, så undskyld mig, hvis det ligner noget rod. :D
Sub PDFTOEMAIL()
Dim xSht som arbejdsark
Dim xFileDlg Som FileDialog
Dim xFolder Som streng
Dim xYesorNo Som heltal
Dim xOutlookObj som objekt
Dim xEmailObj Som objekt
Dim xUsedRng As Range
Dim xPath som streng
Dim xOutMsg As String
Dim sFolderName As String, sFolder As String
Dim sFolderPath Som streng

Indstil xSht = ActiveSheet
xFileDate = Format(Nu, "dd-mm-åååå")
sFolder = "C:" 'her er hvor du har en hovedmappe
sFolderName = "Ugeafslutning " + Format(Nu, "dd-mm-åååå") 'mappe skal oprettes i hovedmappe med navn Ugeafslutning og nuværende dato
sFolderPath = "C:" & sFolderName 'hovedmappe igen for at oprette den nye sti inklusive den nye mappe
Indstil oFSO = CreateObject("Scripting.FileSystemObject")
Hvis oFSO.FolderExists(sFolderPath) Så
MsgBox "Mappe findes allerede!" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
Else
MkDir sFolderPath
MsgBox "Ny mappe er blevet oprettet!" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
End If
xPath = sFolderPath
xFolder = xPath + "\" + xSht.Name + "_" + xFileDate + ".pdf"
Hvis Len(Dir(xFolder)) > 0 Så
xYesorNo = MsgBox(xFolder & " eksisterer allerede." & vbCrLf & vbCrLf & "Vil du overskrive den?", _
vbYesNo + vbSpørgsmål, "Filen findes")
On Error Resume Next
Hvis xYesorNo = vbYes Then
Dræb xFolder
Else
MsgBox "hvis du ikke overskriver den eksisterende PDF, kan jeg ikke fortsætte." _
& vbCrLf & vbCrLf & "Tryk på OK for at afslutte denne makro.", vbCritical, "Exiting Macro"
Exit Sub
End If
Hvis Err.Number <> 0 Så
MsgBox "Kan ikke slette eksisterende fil. Sørg for, at filen ikke er åben eller skrivebeskyttet." _
& vbCrLf & vbCrLf & "Tryk på OK for at afslutte denne makro.", vbCritical, "Unable to Delete File"
Exit Sub
End If
End If

Indstil xUsedRng = xSht.UsedRange
Hvis Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Så
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filnavn:=xFolder, Kvalitet:=xlQualityStandard
Indstil xOutlookObj = CreateObject("Outlook.Application")
Indstil xEmailObj = xOutlookObj.CreateItem(0)
xOutMsg = " Find venligst vedhæftet Denne e-mail og den vedhæftede fil er blevet genereret automatisk "
'tilføjer en bemærkning om, at e-mailen blev genereret automatisk

Med xEmailObj
.Skærm
.To = "" 'tilføj dine egne e-mails
.CC = ""
.Subject = xSht.Name + " PDF for week ending " + xFileDate + " - Location " ' emne inkluderer arknavn, pdf, dato og placering, dette kan redigeres efter behov
.Attachments.Add xFolder
.HTMLBody = xOutMsg & .HTMLBody
Hvis DisplayEmail = Falsk Så
'.Send <--- Her, hvis du sletter apostrof, vil e-mailen blive sendt automatisk, så vær forsigtig
End If
Slut med
Else
MsgBox "Det aktive regneark må ikke være tomt"
Exit Sub
End If
End Sub
Svar
Rapport
0
0
Nicole
Nicole
Denne kommentar blev minimeret af moderatoren på webstedet
Hvordan redigerer jeg denne kode til kun at gemme celler ("a1:r99") for at gemme som PDF. Jeg har ekstra ting på siderne, jeg ikke vil have i mit PDF-dokument.
Sub Gemaspdfandsend()
'Opdateret af Extendoffice 20210209
Dim xSht som arbejdsark
Dim xFileDlg Som FileDialog
Dim xFolder Som streng
Dim xYesorNo Som heltal
Dim xOutlookObj som objekt
Dim xEmailObj Som objekt
Dim xUsedRng As Range
Dim xStrName Som streng
Dim xV Som Variant

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

Hvis xFileDlg.Show = Sand Så
xFolder = xFileDlg.SelectedItems(1)
Else
MsgBox "Du skal angive en mappe at gemme PDF'en i." & vbCrLf & vbCrLf & "Tryk på OK for at afslutte denne makro.", vbCritical, "Must Specific Destination Folder"
Exit Sub
End If
xStrName = ""
xV = Application.InputBox("Indtast venligst filnavnet:", "Kutools for Excel", , , , , , 2)
Hvis xV = Falsk Så
Exit Sub
End If
xStrName = xV
Hvis xStrName = "" Så
MsgBox ("Intet filnavn indtastet, afslutter proces!")
Exit Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
'Tjek, om filen allerede eksisterer
Hvis Len(Dir(xFolder)) > 0 Så
xYesorNo = MsgBox(xFolder & " eksisterer allerede." & vbCrLf & vbCrLf & "Vil du overskrive den?", _
vbYesNo + vbSpørgsmål, "Filen findes")
On Error Resume Next
Hvis xYesorNo = vbYes Then
Dræb xFolder
Else
MsgBox "hvis du ikke overskriver den eksisterende PDF, kan jeg ikke fortsætte." _
& vbCrLf & vbCrLf & "Tryk på OK for at afslutte denne makro.", vbCritical, "Exiting Macro"
Exit Sub
End If
Hvis Err.Number <> 0 Så
MsgBox "Kan ikke slette eksisterende fil. Sørg for, at filen ikke er åben eller skrivebeskyttet." _
& vbCrLf & vbCrLf & "Tryk på OK for at afslutte denne makro.", vbCritical, "Unable to Delete File"
Exit Sub
End If
End If

Indstil xUsedRng = xSht.UsedRange
Hvis Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Så
'Gem som PDF-fil
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filnavn:=xFolder, Kvalitet:=xlQualityStandard

'Opret Outlook-e-mail
Indstil xOutlookObj = CreateObject("Outlook.Application")
Indstil xEmailObj = xOutlookObj.CreateItem(0)
Med xEmailObj
.Skærm
.Til = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Add xFolder
Hvis DisplayEmail = Falsk Så
'.Sende
End If
Slut med
Else
MsgBox "Det aktive regneark må ikke være tomt"
Exit Sub
End If
End Sub
Svar
0
0
RLF
RLF     Nicole
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, jeg har lige prøvet denne kode på et af mine regneark, og jeg har indstillet printområder, så de ekstra ting nederst ikke kom med i pdf'en. Prøv det!
Svar
0
0
Rod Bennett
Rod Bennett
Denne kommentar blev minimeret af moderatoren på webstedet
Hi
Mange tak for koden, men er det muligt at gemme PDF'en automatisk på samme sted som den aktive Excel-fil og med samme filnavn som den aktive Excel-fil?
Mange tak.
Rod
Svar
0
0
Der er endnu ingen kommentarer her
Load More
Efterlad dine kommentarer
Gæst
Sender som gæst
Login
×
Bedøm dette indlæg:
Nulstil
0   Tegn
Foreslåede steder

Følg os

Copyright © 2009 - www.extendoffice.com. | Alle rettigheder forbeholdes. Drevet af ExtendOffice. | | Sitemap
Microsoft og Office-logoet er varemærker eller registrerede varemærker tilhørende Microsoft Corporation i USA og / eller andre lande.
Beskyttet af Sectigo SSL