Note: The other languages of the website are Google-translated. Back to English
Logga in Registrera

Hur sparar jag ett kalkylblad som PDF-fil och skickar det via e-post som en bilaga via Outlook?

I vissa fall kan du behöva skicka ett kalkylblad som en PDF-fil via Outlook. Vanligtvis måste du spara kalkylbladet manuellt som en PDF-fil, skapa sedan ett nytt e-postmeddelande med denna PDF-fil som bilaga i Outlook och slutligen skicka det. Det är tidskrävande att uppnå det manuellt steg för steg. I den här artikeln visar vi dig hur du snabbt sparar ett kalkylblad som en PDF-fil och skickar det automatiskt som en bilaga via Outlook i Excel.

Spara ett kalkylblad som PDF-fil och mejla det som en bilaga med VBA-kod

Spara ett kalkylblad som PDF-fil och mejla det som en bilaga med VBA-kod

Du kan köra nedanstående VBA-kod för att automatiskt spara det aktiva kalkylbladet som en PDF-fil och sedan skicka det som en bilaga via Outlook. Gör så här.

1. Öppna kalkylbladet som du sparar som PDF och skicka och tryck sedan på andra + F11 samtidigt för att öppna Microsoft Visual Basic för applikationer fönster.

2. I Microsoft Visual Basic för applikationer fönstret klickar Insert > Modulerna. Kopiera sedan och klistra in nedanstående VBA-kod i Koda fönster. Se skärmdump:

VBA-kod: Spara ett kalkylblad som PDF-fil och mejla det som en bilaga

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. tryck på F5 för att köra koden. I Bläddra välj en mapp för att spara den här PDF-filen och klicka sedan på OK knapp.

Anmärkningar:

1. Nu sparas det aktiva kalkylbladet som PDF-fil. Och PDF-filen heter namnet på kalkylbladet.
2. Om det aktiva kalkylbladet är tomt kommer du att få en dialogruta som visas nedan när du klickar på OK knapp.

4. Nu skapas ett nytt Outlook-e-postmeddelande och du kan se att PDF-filen listas som en bilaga i den bifogade filen. Se skärmdump:

5. Skriv detta e-postmeddelande och skicka det sedan.
6. Den här koden är endast tillgänglig när du använder Outlook som ditt e-postprogram.

Spara enkelt ett kalkylblad eller flera kalkylblad som separata PDF-filer samtidigt:

Du har nu möjlighet Dela arbetsbok nytta av Kutools för Excel kan hjälpa dig att enkelt spara ett kalkylblad eller flera kalkylblad som separata PDF-filer samtidigt som nedanstående demo visas. Ladda ner och prova nu! (30-dagars gratis led)

Relaterade artiklar:

De bästa Office-produktivitetsverktygen

Kutools för Excel löser de flesta av dina problem och ökar din produktivitet med 80%

  • återanvändning: Sätt snabbt i komplexa formler, diagram och allt som du har använt tidigare; Kryptera celler med lösenord; Skapa e-postlista och skicka e-post ...
  • Super Formula Bar (enkelt redigera flera rader med text och formel); Läslayout (enkelt läsa och redigera ett stort antal celler); Klistra in i filtrerat intervall...
  • Sammanfoga celler / rader / kolumner utan att förlora data; Delat cellinnehåll; Kombinera duplicerade rader / kolumner... Förhindra duplicerade celler; Jämför intervall...
  • Välj Duplicera eller Unikt Rader; Välj tomma rader (alla celler är tomma); Super Find och Fuzzy Find i många arbetsböcker; Slumpmässigt val ...
  • Exakt kopia Flera celler utan att ändra formelreferens; Skapa referenser automatiskt till flera ark; Sätt in kulor, Kryssrutor och mer ...
  • Extrahera text, Lägg till text, ta bort efter position, Ta bort mellanslag; Skapa och skriva ut personsökningstalsatser; Konvertera mellan celler innehåll och kommentarer...
  • Superfilter (spara och tillämpa filterscheman på andra ark); Avancerad sortering efter månad / vecka / dag, frekvens och mer; Specialfilter av fet, kursiv ...
  • Kombinera arbetsböcker och arbetsblad; Sammanfoga tabeller baserat på nyckelkolumner; Dela data i flera ark; Batchkonvertera xls, xlsx och PDF...
  • Mer än 300 kraftfulla funktioner. Stöder Office / Excel 2007-2021 och 365. Stöder alla språk. Enkel implementering i ditt företag eller organisation. Fullständiga funktioner 30 dagars gratis provperiod. 60 dagars pengarna tillbaka-garanti.
kte-flik 201905

Fliken Office ger ett flikgränssnitt till Office och gör ditt arbete mycket enklare

  • Aktivera flikredigering och läsning i Word, Excel, PowerPoint, Publisher, Access, Visio och Project.
  • Öppna och skapa flera dokument i nya flikar i samma fönster, snarare än i nya fönster.
  • Ökar din produktivitet med 50 % och minskar hundratals musklick för dig varje dag!
officetab botten
Sortera kommentarer efter
äldsta först
nyaste först
Kommentarer (63)
Klassad 5 av 5 · 1 betyg
Michael
Michael
Denna kommentar minimerades av moderatoren på webbplatsen
Det här fungerar utmärkt för mig men finns det ett sätt att välja en mappplats automatiskt istället för att välja manuellt? Jag hoppas kunna göra detta för 40 ark samtidigt.
Svara
0
0
Hugh
Hugh     Michael
Denna kommentar minimerades av moderatoren på webbplatsen
Hoppas också på att få svar på denna fråga! Tack för hjälpen!
Svara
0
0
Darren
Darren
Denna kommentar minimerades av moderatoren på webbplatsen
Jag har försökt klistra in det här i en ny modul och jag får kompileringsfel: Sub eller Funktion inte definierad. Snälla hjälp.
Svara
0
0
kristall
kristall     Darren
Denna kommentar minimerades av moderatoren på webbplatsen
Kära Darren,
Vilken Office-version använder du?
Svara
Report
0
0
Nakia
Nakia     kristall
Denna kommentar minimerades av moderatoren på webbplatsen
office 360
Svara
0
0
Bill
Bill     Darren
Denna kommentar minimerades av moderatoren på webbplatsen
Samma fråga
Svara
0
0
Michael Charry
Michael Charry
Denna kommentar minimerades av moderatoren på webbplatsen
Hur skulle jag redigera VBA-skriptet ovan så att det lägger till en datum- och tidsstämpel till filnamnet så att det inte fortsätter att skriva över det som redan är sparat?
Svara
Report
0
0
kristall
kristall     Michael Charry
Denna kommentar minimerades av moderatoren på webbplatsen
Kära Michael,
Kör nedanstående VBA-kod för att lösa problemet.

Sub Saveaspdfandsend()
Dim xSht Som arbetsblad
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo Som heltal
Dim xOutlookObj Som objekt
Dim xEmailObj As Object
Dim xUsedRng As Range
Dim xStr As String

Ställ in xSht = ActiveSheet
Ställ in xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Om xFileDlg.Show = Sant då
xFolder = xFileDlg.SelectedItems(1)
annars
MsgBox "Du måste ange en mapp att spara PDF-filen i." & vbCrLf & vbCrLf & "Tryck på OK för att avsluta detta makro.", vbCritical, "Måste ange målmapp"
Exit Sub
End If
xStr = Format(Now(), "åååå-mm-dd-tt-mm-ss")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'Kontrollera om filen redan finns
Om Len(Dir(xFolder)) > 0 Då
xYesorNo = MsgBox(xFolder & " finns redan." & vbCrLf & vbCrLf & "Vill du skriva över den?", _
vbYesNo + vbQuestion, "Fil existerar")
On Error Resume Next
Om xYesorNo = vbYes Då
Döda xFolder
annars
MsgBox "om du inte skriver över den befintliga PDF-filen kan jag inte fortsätta." _
& vbCrLf & vbCrLf & "Tryck på OK för att avsluta detta makro.", vbCritical, "Exiting Macro"
Exit Sub
End If
Om Err.Number <> 0 Då
MsgBox "Det gick inte att ta bort befintlig fil. Se till att filen inte är öppen eller skrivskyddad." _
& vbCrLf & vbCrLf & "Tryck på OK för att avsluta detta makro.", vbCritical, "Kan inte ta bort fil"
Exit Sub
End If
End If

Ställ in xUsedRng = xSht.UsedRange
Om Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Då
'Spara som PDF-fil
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filnamn:=xFolder, Quality:=xlQualityStandard

'Skapa Outlook-e-post
Ställ in xOutlookObj = CreateObject("Outlook.Application")
Ställ in xEmailObj = xOutlookObj.CreateItem(0)
Med xEmailObj
.Visa
.Till = ""
.CC = ""
.Subject = xSht.Name + "-" + xStr + ".pdf"
.Bilagor.Lägg till xFolder
Om DisplayEmail = False Då
'.Skicka
End If
Sluta med
annars
MsgBox "Det aktiva kalkylbladet kan inte vara tomt"
Exit Sub
End If
End Sub
Svara
Report
0
0
Parag Somani
Parag Somani     kristall
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Crystal,

Det är riktigt bra och fungerar perfekt för mig. Behöver mer hjälp att lägga till:

1. i "Till" vill jag ge en länk till en viss cell i det aktiva arket som i CC och i BCC skulle jag vilja lägga till en aktiv arklänk
2. I e-posttexten måste jag ange någon standardtext.

Jag kommer att vara mycket full till dig för din hjälp.

Tack
paragraf
Svara
0
0
kristall
kristall     Parag Somani
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Parag Somani,
VBA-koden nedan kan hjälpa dig. Ändra fälten .Till, .CC, .BCC och .Body baserat på dina behov.

Sub Saveaspdfandsend()
Dim xSht Som arbetsblad
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo Som heltal
Dim xOutlookObj Som objekt
Dim xEmailObj As Object
Dim xUsedRng As Range
Dim xStr As String

Ställ in xSht = ActiveSheet
Ställ in xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Om xFileDlg.Show = Sant då
xFolder = xFileDlg.SelectedItems(1)
annars
MsgBox "Du måste ange en mapp att spara PDF-filen i." & vbCrLf & vbCrLf & "Tryck på OK för att avsluta detta makro.", vbCritical, "Måste ange målmapp"
Exit Sub
End If
xStr = Format(Now(), "åååå-mm-dd-tt-mm-ss")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'Kontrollera om filen redan finns
Om Len(Dir(xFolder)) > 0 Då
xYesorNo = MsgBox(xFolder & " finns redan." & vbCrLf & vbCrLf & "Vill du skriva över den?", _
vbYesNo + vbQuestion, "Fil existerar")
On Error Resume Next
Om xYesorNo = vbYes Då
Döda xFolder
annars
MsgBox "om du inte skriver över den befintliga PDF-filen kan jag inte fortsätta." _
& vbCrLf & vbCrLf & "Tryck på OK för att avsluta detta makro.", vbCritical, "Exiting Macro"
Exit Sub
End If
Om Err.Number <> 0 Då
MsgBox "Det gick inte att ta bort befintlig fil. Se till att filen inte är öppen eller skrivskyddad." _
& vbCrLf & vbCrLf & "Tryck på OK för att avsluta detta makro.", vbCritical, "Kan inte ta bort fil"
Exit Sub
End If
End If

Ställ in xUsedRng = xSht.UsedRange
Om Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Då
'Spara som PDF-fil
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filnamn:=xFolder, Quality:=xlQualityStandard

'Skapa Outlook-e-post
Ställ in xOutlookObj = CreateObject("Outlook.Application")
Ställ in xEmailObj = xOutlookObj.CreateItem(0)
Med xEmailObj
.Visa
.To = Range("A8")
.CC = Range("A9")
.BCC = Range("A10")
.Subject = xSht.Name + "-" + xStr + ".pdf"
.Body = "Kära" _
& vbNewLine & vbNewLine & _
"Detta är ett testmail" & _
"skicka i Excel"
.Bilagor.Lägg till xFolder
Om DisplayEmail = False Då
'.Skicka
End If
Sluta med
annars
MsgBox "Det aktiva kalkylbladet kan inte vara tomt"
Exit Sub
End If
End Sub
Svara
Report
0
0
Mehul
Mehul     kristall
Denna kommentar minimerades av moderatoren på webbplatsen
Jag har försökt använda intervallet för "Till", "CC", det tar bara inte upp värdena från den angivna cellen. Kan du snälla hjälpa till med detta?
Tack,
Mehul
Svara
0
0
Parag Somani
Parag Somani     kristall
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Crystal,

Det är riktigt bra och fungerar perfekt för mig. Behöver mer hjälp att lägga till:

1. i "Till" vill jag ge en länk till en viss cell i det aktiva arket som i CC och i BCC skulle jag vilja lägga till en aktiv arklänk
2. I e-posttexten måste jag ange någon standardtext.

Jag kommer att vara mycket full till dig för din hjälp.

Tack
paragraf
Svara
0
0
paragraf
paragraf     kristall
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Crystal,

Det är riktigt bra och fungerar perfekt för mig. Behöver mer hjälp att lägga till:

1. i "Till" vill jag ge en länk till en viss cell i det aktiva arket som i CC och i BCC skulle jag vilja lägga till en aktiv arklänk
2. I e-posttexten måste jag ange någon standardtext.

Jag kommer att vara mycket full till dig för din hjälp.

Tack
paragraf
Svara
Report
0
0
Armin
Armin
Denna kommentar minimerades av moderatoren på webbplatsen
Hur kan jag lägga till till exempel blad 2 från arbetsboken som en pdf?
Svara
0
0
kristall
kristall     Armin
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Armin,
Du måste först öppna ark 2 i din arbetsbok och sedan köra VBA-koden med ovanstående steg för att få ner den.
Svara
Report
0
0
Tom H
Tom H
Denna kommentar minimerades av moderatoren på webbplatsen
Hur skulle jag redigera VBA-skriptet ovan så att filnamnet sparas som en specifik cell vald i det aktuella arket, till exempel cell A1?
Svara
0
0
kristall
kristall     Tom H
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Tom.
Jag kan tyvärr inte hjälpa till med detta.
Välkommen att ställa alla frågor i vårt forum: https://www.extendoffice.com/forum.html
Du kommer att få mer Excel-stöd från Excel-proffs eller andra Excel-fans.
Svara
Report
0
0
james
james
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, hur kan jag spara och skicka pdf:en med arbetsbokens namn med den aktuella VBA-koden? vad använder jag istället för xSht.Name
Svara
0
0
kristall
kristall     james
Denna kommentar minimerades av moderatoren på webbplatsen
Hej James,
Vill du skicka det aktiva kalkylbladet som pdf och namnge det som arbetsbokens namn?
Svara
Report
0
0
Ranga
Ranga
Denna kommentar minimerades av moderatoren på webbplatsen
Tack det fungerar.
Svara
0
0
Jason
Jason
Denna kommentar minimerades av moderatoren på webbplatsen
Hur kan jag få den att ta bort den sparade pdf-filen efter att den har skickat den via e-post?
Svara
0
0
kristall
kristall     Jason
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Jason,
Jag kan tyvärr inte hjälpa dig med det än. Du måste ta bort den manuellt efter att ha skickat den via e-post.
Svara
Report
0
0
Odd-Inge
Odd-Inge
Denna kommentar minimerades av moderatoren på webbplatsen
Hallå,

Är det möjligt att hitta namnet på pdf från en cell? Ex. Cell H4


Och i cell H4 vill jag att den ska samlas in från tre olika celler. Är detta möjligt?
Svara
0
0
Taylor
Taylor     Odd-Inge
Denna kommentar minimerades av moderatoren på webbplatsen
Det här är möjligt. Gör separata variabler för att hålla värdet från cellerna och använd sedan dessa variabler när du ställer in xFolder.
Jag använde värdet från en cell i mitt ark plus dagens datum. Du kan dock enkelt göra flera cellvärden.

Det här är vad jag har lagt till:
Dim xMemberName As String
Dim xFileDate As String

xMemberName = Range("H3").Value
xFileDate = Format(Nu, "mm-dd")

xFolder = xFolder + "\" xMedlemsnamn + xFileDate + ".pdf"
Svara
0
0
sora
sora     Taylor
Denna kommentar minimerades av moderatoren på webbplatsen
Jag får ett felmeddelande när jag försöker detta, var i koden ska jag placera detta?
Svara
0
0
Kishore
Kishore
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Crystal,



Det är riktigt bra och fungerar perfekt för mig. Behöver mer hjälp att lägga till:

1. I "Body" vill jag ge en länk till en viss cell i det aktiva arket. Vidare Skulle vilja feta texten.

Tack

Hälsningar

Kishore Kumar
Svara
Report
0
0
kristall
kristall     Kishore
Denna kommentar minimerades av moderatoren på webbplatsen
Hej,

Menar du att lägga till cellvärdet automatiskt i brevkroppen och fetstil det? Anta att du lägger till värdet av C4 till e-postmeddelandet. Använd koden nedan.

Sub Saveaspdfandsend()

Dim xSht Som arbetsblad

Dim xFileDlg As FileDialog

Dim xFolder As String

Dim xYesorNo Som heltal

Dim xOutlookObj Som objekt

Dim xEmailObj As Object

Dim xUsedRng As Range



Ställ in xSht = ActiveSheet

Ställ in xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)



Om xFileDlg.Show = Sant då

xFolder = xFileDlg.SelectedItems(1)

annars

MsgBox "Du måste ange en mapp att spara PDF-filen i." & vbCrLf & vbCrLf & "Tryck på OK för att avsluta detta makro.", vbCritical, "Måste ange målmapp"

Exit Sub

End If

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



'Kontrollera om filen redan finns

Om Len(Dir(xFolder)) > 0 Då

xYesorNo = MsgBox(xFolder & " finns redan." & vbCrLf & vbCrLf & "Vill du skriva över den?", _

vbYesNo + vbQuestion, "Fil existerar")

On Error Resume Next

Om xYesorNo = vbYes Då

Döda xFolder

annars

MsgBox "om du inte skriver över den befintliga PDF-filen kan jag inte fortsätta." _

& vbCrLf & vbCrLf & "Tryck på OK för att avsluta detta makro.", vbCritical, "Exiting Macro"

Exit Sub

End If

Om Err.Number <> 0 Då

MsgBox "Det gick inte att ta bort befintlig fil. Se till att filen inte är öppen eller skrivskyddad." _

& vbCrLf & vbCrLf & "Tryck på OK för att avsluta detta makro.", vbCritical, "Kan inte ta bort fil"

Exit Sub

End If

End If



Ställ in xUsedRng = xSht.UsedRange

Om Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Då

'Spara som PDF-fil

xSht.ExportAsFixedFormat Type:=xlTypePDF, Filnamn:=xFolder, Quality:=xlQualityStandard



'Skapa Outlook-e-post

Ställ in xOutlookObj = CreateObject("Outlook.Application")

Ställ in xEmailObj = xOutlookObj.CreateItem(0)

Med xEmailObj

.Visa

.Till = ""

.CC = ""

.Subject = xSht.Name + ".pdf"

.Bilagor.Lägg till xFolder

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

Om DisplayEmail = False Då

'.Skicka

End If

Sluta med

annars

MsgBox "Det aktiva kalkylbladet kan inte vara tomt"

Exit Sub

End If

End Sub
Svara
Report
0
0
Geoff
Geoff
Denna kommentar minimerades av moderatoren på webbplatsen
Om jag ville att det skulle sparas automatiskt i en specifik mapp varje gång (vilket eliminerar behovet för användaren att välja mappen), hur skulle jag göra det?
Ex. C: Fakturor/Nordamerika/Kunder
Hjälp uppskattas mycket.
Svara
0
0
kristall
kristall     Geoff
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Geoff,
Menar du spara arbetsbladet som en pdf-fil och spara i en specifik mapp utan att skicka?
Svara
Report
0
0
jeremy
jeremy     kristall
Denna kommentar minimerades av moderatoren på webbplatsen
Jag tror att Geoff innebär att man kan specificera en specifik mapp i koden som pdf:en sparas till varje gång istället för att behöva välja platsen manuellt. Pdf-filen skickas sedan via e-post från den specifika mappen.
Svara
0
0
kristall
kristall     jeremy
Denna kommentar minimerades av moderatoren på webbplatsen
Tack Jeremy.
Svara
Report
0
0
kristall
kristall     Geoff
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Geoff, Om du vill spara pdf-filen automatiskt i en specifik mapp istället för att välja platsen manuellt, försök med koden nedan. Glöm inte att ändra mappsökvägen i koden.
Sub SaveAsPDFandSend()
Dim xSht Som arbetsblad
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo Som heltal
Dim xOutlookObj Som objekt
Dim xEmailObj As Object
Dim xUsedRng As Range
Dim xPath som sträng
Ställ in xSht = ActiveSheet
xPath = "C:\Users\Win10x64Test\Desktop\worksheet till pdf" 'här är "kalkylblad till pdf" målmappen för att spara pdf-filerna
xFolder = xPath + "\" + xSht.Name + ".pdf"
Om Len(Dir(xFolder)) > 0 Då
xYesorNo = MsgBox(xFolder & " finns redan." & vbCrLf & vbCrLf & "Vill du skriva över den?", _
vbYesNo + vbQuestion, "Fil existerar")
On Error Resume Next
Om xYesorNo = vbYes Då
Döda xFolder
annars
MsgBox "om du inte skriver över den befintliga PDF-filen kan jag inte fortsätta." _
& vbCrLf & vbCrLf & "Tryck på OK för att avsluta detta makro.", vbCritical, "Exiting Macro"
Exit Sub
End If
Om Err.Number <> 0 Då
MsgBox "Det gick inte att ta bort befintlig fil. Se till att filen inte är öppen eller skrivskyddad." _
& vbCrLf & vbCrLf & "Tryck på OK för att avsluta detta makro.", vbCritical, "Kan inte ta bort fil"
Exit Sub
End If
End If

Ställ in xUsedRng = xSht.UsedRange
Om Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Då
'Spara som PDF-fil
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filnamn:=xFolder, Quality:=xlQualityStandard

'Skapa Outlook-e-post
Ställ in xOutlookObj = CreateObject("Outlook.Application")
Ställ in xEmailObj = xOutlookObj.CreateItem(0)
Med xEmailObj
.Visa
.Till = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Bilagor.Lägg till xFolder
Om DisplayEmail = False Då
'.Skicka
End If
Sluta med
annars
MsgBox "Det aktiva kalkylbladet kan inte vara tomt"
Exit Sub
End If
End Sub
Svara
Report
0
0
Alison
Alison
Denna kommentar minimerades av moderatoren på webbplatsen
Den här koden fungerar utmärkt förutom att jag vill ha arbetsbladet sparat som arknamn + datum (dvs. Blad 1 oktober 1 2020); på användarens skrivbord (detta kommer att användas av flera personer och deras vägar kan variera något). Om möjligt vill jag bädda in en .jpg i brödtexten också. JPG finns både inne i kalkylbladet (utanför utskriftsområdet) och bilden lagras på en delad server.. även om sökvägen till servern varierar beroende på användare (för de flesta är det en "T"-enhet för vissa en "U"-enhet)
kan detta göras? snälla och tack en miljon gånger.
Svara
0
0
Deepak
Deepak
Denna kommentar minimerades av moderatoren på webbplatsen

Hej, det fungerar utmärkt tack för att du delar, behöver bara en hjälp.
Om jag vill spara en PDF-fil med anpassat namn (möjlighet att skriva filnamn i dialogrutan Spara som), som användaren använder detta alternativ i formulärmall där formulär sparas som PDF med unikt namn.
Svara
Report
0
0
kristall
kristall     Deepak
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, Vänligen prova nedanstående VBA-kod. När du har kört koden, välj en mapp för att spara PDF-filen, sedan dyker en dialogruta upp där du kan ange filnamnet. Sub Saveaspdfandsend()
'Uppdaterad av Extendoffice 20210209
Dim xSht Som arbetsblad
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo Som heltal
Dim xOutlookObj Som objekt
Dim xEmailObj As Object
Dim xUsedRng As Range
Dim xStrName As String
Dim xV Som variant

Ställ in xSht = ActiveSheet
Ställ in xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Om xFileDlg.Show = Sant då
xFolder = xFileDlg.SelectedItems(1)
annars
MsgBox "Du måste ange en mapp att spara PDF-filen i." & vbCrLf & vbCrLf & "Tryck på OK för att avsluta detta makro.", vbCritical, "Måste ange målmapp"
Exit Sub
End If
xStrName = ""
xV = Application.InputBox("Ange filnamnet:", "Kutools for Excel", , , , , , 2)
Om xV = Falskt då
Exit Sub
End If
xStrName = xV
Om xStrName = "" Då
MsgBox ("Inget filnamn angett, processen avslutas!")
Exit Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
'Kontrollera om filen redan finns
Om Len(Dir(xFolder)) > 0 Då
xYesorNo = MsgBox(xFolder & " finns redan." & vbCrLf & vbCrLf & "Vill du skriva över den?", _
vbYesNo + vbQuestion, "Fil existerar")
On Error Resume Next
Om xYesorNo = vbYes Då
Döda xFolder
annars
MsgBox "om du inte skriver över den befintliga PDF-filen kan jag inte fortsätta." _
& vbCrLf & vbCrLf & "Tryck på OK för att avsluta detta makro.", vbCritical, "Exiting Macro"
Exit Sub
End If
Om Err.Number <> 0 Då
MsgBox "Det gick inte att ta bort befintlig fil. Se till att filen inte är öppen eller skrivskyddad." _
& vbCrLf & vbCrLf & "Tryck på OK för att avsluta detta makro.", vbCritical, "Kan inte ta bort fil"
Exit Sub
End If
End If

Ställ in xUsedRng = xSht.UsedRange
Om Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Då
'Spara som PDF-fil
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filnamn:=xFolder, Quality:=xlQualityStandard

'Skapa Outlook-e-post
Ställ in xOutlookObj = CreateObject("Outlook.Application")
Ställ in xEmailObj = xOutlookObj.CreateItem(0)
Med xEmailObj
.Visa
.Till = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Bilagor.Lägg till xFolder
Om DisplayEmail = False Då
'.Skicka
End If
Sluta med
annars
MsgBox "Det aktiva kalkylbladet kan inte vara tomt"
Exit Sub
End If
End Sub
Svara
Report
0
0
mleczus94
mleczus94
Denna kommentar minimerades av moderatoren på webbplatsen
Hej,
Om jag har två ark i filen och jag skulle vilja köra detta makro på ett ark (genom att trycka på knappen) men skicka ett annat, hur kan jag få det?
Svara
Report
0
0
va
va
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, jag skulle vilja spara detta på en viss filplats, med namnet baserat på värdet i cell C30. Jag har försökt några alternativ, men får fortfarande fel.
Svara
0
0
kristall
kristall     va
Denna kommentar minimerades av moderatoren på webbplatsen
Hej hein, Koden nedan kanske kan hjälpa. Efter att ha kört koden, välj en viss mapp för att spara PDF-filen, sedan dyker en dialogruta upp där du kan ange filnamnet. Sub Saveaspdfandsend()
'Uppdaterad av Extendoffice 20210209
Dim xSht Som arbetsblad
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo Som heltal
Dim xOutlookObj Som objekt
Dim xEmailObj As Object
Dim xUsedRng As Range
Dim xStrName As String
Dim xV Som variant

Ställ in xSht = ActiveSheet
Ställ in xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Om xFileDlg.Show = Sant då
xFolder = xFileDlg.SelectedItems(1)
annars
MsgBox "Du måste ange en mapp att spara PDF-filen i." & vbCrLf & vbCrLf & "Tryck på OK för att avsluta detta makro.", vbCritical, "Måste ange målmapp"
Exit Sub
End If
xStrName = ""
xV = Application.InputBox("Ange filnamnet:", "Kutools for Excel", , , , , , 2)
Om xV = Falskt då
Exit Sub
End If
xStrName = xV
Om xStrName = "" Då
MsgBox ("Inget filnamn angett, processen avslutas!")
Exit Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
'Kontrollera om filen redan finns
Om Len(Dir(xFolder)) > 0 Då
xYesorNo = MsgBox(xFolder & " finns redan." & vbCrLf & vbCrLf & "Vill du skriva över den?", _
vbYesNo + vbQuestion, "Fil existerar")
On Error Resume Next
Om xYesorNo = vbYes Då
Döda xFolder
annars
MsgBox "om du inte skriver över den befintliga PDF-filen kan jag inte fortsätta." _
& vbCrLf & vbCrLf & "Tryck på OK för att avsluta detta makro.", vbCritical, "Exiting Macro"
Exit Sub
End If
Om Err.Number <> 0 Då
MsgBox "Det gick inte att ta bort befintlig fil. Se till att filen inte är öppen eller skrivskyddad." _
& vbCrLf & vbCrLf & "Tryck på OK för att avsluta detta makro.", vbCritical, "Kan inte ta bort fil"
Exit Sub
End If
End If

Ställ in xUsedRng = xSht.UsedRange
Om Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Då
'Spara som PDF-fil
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filnamn:=xFolder, Quality:=xlQualityStandard

'Skapa Outlook-e-post
Ställ in xOutlookObj = CreateObject("Outlook.Application")
Ställ in xEmailObj = xOutlookObj.CreateItem(0)
Med xEmailObj
.Visa
.Till = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Bilagor.Lägg till xFolder
Om DisplayEmail = False Då
'.Skicka
End If
Sluta med
annars
MsgBox "Det aktiva kalkylbladet kan inte vara tomt"
Exit Sub
End If
End Sub
Svara
Report
0
0
Hein
Hein     kristall
Denna kommentar minimerades av moderatoren på webbplatsen
Tack för det, det är bra, men jag vill att bladet ska heta enligt cell A1 på blad 1. platsen att spara enligt A1 på blad 2 till exempel C:\Users\peete\Dropbox\Skärmdumpar och e-post skicka till mailadress på A3 ark 2 vad jag redan har räknat ut.
Svara
0
0
HeinPeeters
HeinPeeters     kristall
Denna kommentar minimerades av moderatoren på webbplatsen
Tack för det, det är bra, men jag vill att bladet ska heta enligt cell A1 på blad 1. platsen att spara enligt A1 på blad 2 till exempel C:\Users\peete\Dropbox\Skärmdumpar, men kan ändras när använda filen, och e-post skicka till e-postadress på A3-ark 2 vad jag redan har räknat ut.
Svara
Report
0
0
BenSpo
BenSpo
Denna kommentar minimerades av moderatoren på webbplatsen
Hi kristall , utmärkt kod tack för att du delar. Finns det något sätt att välja flera ark (från samma arbetsbok) för att spara var och en som en oberoende PDF och sedan skicka dem alla bifogade i ett e-postmeddelande?
Svara
Report
0
0
kristall
kristall     BenSpo
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, VBA-koden nedan kan göra dig en tjänst, försök gärna. I den tolfte raden i koden, ersätt arknamnen med de faktiska arknamnen i ditt fall.
Sub Saveaspdfandsend1()
Dim xSht Som arbetsblad
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xJasorNej, I, xNum Som heltal
Dim xOutlookObj Som objekt
Dim xEmailObj As Object
Dim xUsedRng As Range
Dim xArrShetts som variant
Dim xPDFNameAddress As String
Dim xStr As String
xArrShetts = Array("testa", "Sheet1", "Sheet2") 'Ange arknamnen du kommer att skicka som pdf-filer med citattecken och separera dem med kommatecken. Se till att det inte finns några specialtecken som \/:"*<>| i filnamnet.

För I = 0 Till UBound(xArrShetts)
On Error Resume Next
Ställ in xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))
Om xSht.Name <> xArrShetts(I) Då
MsgBox "Worksheet no found, exit operation:" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
Exit Sub
End If
Nästa


Ställ in xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
Om xFileDlg.Show = Sant då
xFolder = xFileDlg.SelectedItems(1)
annars
MsgBox "Du måste ange en mapp att spara PDF-filen i." & vbCrLf & vbCrLf & "Tryck på OK för att avsluta detta makro.", vbCritical, "Måste ange målmapp"
Exit Sub
End If
'Kontrollera om filen redan finns
xYesorNo = MsgBox("Om filer med samma namn finns i målmappen, kommer nummersuffixet att läggas till filnamnet automatiskt för att särskilja dubbletterna" & vbCrLf & vbCrLf & "Klicka på Ja för att fortsätta, klicka på Nej för att avbryta", _
vbYesNo + vbQuestion, "Fil existerar")
Om xYesorNo <> vbYes Avsluta Sub
För I = 0 Till UBound(xArrShetts)
Ställ in xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
xNum = 1
Medan inte (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xNum = xNum + 1
Wend
Ställ in xUsedRng = xSht.UsedRange
Om Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Då
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filnamn:=xStr, Quality:=xlQualityStandard
annars

End If
xArrShetts(I) = xStr
Nästa

'Skapa Outlook-e-post
Ställ in xOutlookObj = CreateObject("Outlook.Application")
Ställ in xEmailObj = xOutlookObj.CreateItem(0)
Med xEmailObj
.Visa
.Till = ""
.CC = ""
.Subject = "????"
För I = 0 Till UBound(xArrShetts)
.Attachments.Add xArrShetts(I)
Nästa
Om DisplayEmail = False Då
'.Skicka
End If
Sluta med
End Sub
Svara
Report
0
0
Berné Rudolph
Berné Rudolph     kristall
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, Den enda förändringen jag kämpar med är att skapa ett separat e-postmeddelande för varje skapat pdf-dokument.
Svara
0
0
kristall
kristall     Berné Rudolph
Denna kommentar minimerades av moderatoren på webbplatsen
Hej! För att skapa ett separat e-postmeddelande för varje pdf-dokument kan du manuellt köra VBA som tillhandahålls i inlägget i olika kalkylblad för att få det gjort.
Svara
Report
0
0
Berné Rudolph
Berné Rudolph     kristall
Denna kommentar minimerades av moderatoren på webbplatsen
Jag har mer än 100 kalkylblad i arbetsboken, vilket då innebär att jag måste köra VBA mer än 100 gånger, vilket är tidskrävande.  
Jag har lyckats dela upp min arbetsbok i flera ark och sedan kan jag konvertera varje kalkylblad till ett individuellt PDF-dokument.
Lösningen jag letar efter är att e-posta varje PDF-dokument separat medan ovanstående process körs.
Härmed VBA:n jag kör för närvarande:
Sub Saveaspdfandsend1()
Dim xSht Som arbetsblad
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xJasorNej, I, xNum Som heltal
Dim xOutlookObj Som objekt
Dim xEmailObj As Object
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", "XNUMX_XNUMX", "XNUMX_XNUMX"
"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", "XNUMX_XNUMX", "XNUMX_XNUMX"
"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", "XNUMX_XNUMX", "XNUMX_XNUMX"
"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", "XNUMX_XNUMX", "XNUMX_XNUMX"
"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", "XNUMX_XNUMX", "XNUMX_XNUMX"
"02563445", "02563737", "02563828", "02563852", "02563861", "02563971", "02564042", _
"02564315", "02564366", "02564832", "02564909", "02565059", "02565205") 'Ange arknamnen du ska skicka som pdf-filer med citattecken och separera dem med kommatecken. Se till att det inte finns några specialtecken som \/:"*<>| i filnamnet.

För I = 0 Till UBound(xArrShetts)
On Error Resume Next
Ställ in xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))
Om xSht.Name <> xArrShetts(I) Då
MsgBox "Worksheet no found, exit operation:" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
Exit Sub
End If
Nästa


Ställ in xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
Om xFileDlg.Show = Sant då
xFolder = xFileDlg.SelectedItems(1)
annars
MsgBox "Du måste ange en mapp att spara PDF-filen i." & vbCrLf & vbCrLf & "Tryck på OK för att avsluta detta makro.", vbCritical, "Måste ange målmapp"
Exit Sub
End If
'Kontrollera om filen redan finns
xYesorNo = MsgBox("Om filer med samma namn finns i målmappen, kommer nummersuffixet att läggas till filnamnet automatiskt för att särskilja dubbletterna" & vbCrLf & vbCrLf & "Klicka på Ja för att fortsätta, klicka på Nej för att avbryta", _
vbYesNo + vbQuestion, "Fil existerar")
Om xYesorNo <> vbYes Avsluta Sub
För I = 0 Till UBound(xArrShetts)
Ställ in xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
xNum = 1
Medan inte (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xNum = xNum + 1
Wend
Ställ in xUsedRng = xSht.UsedRange
Om Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Då
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filnamn:=xStr, Quality:=xlQualityStandard
annars

End If
xArrShetts(I) = xStr
Nästa

'Skapa Outlook-e-post
Ställ in xOutlookObj = CreateObject("Outlook.Application")
Ställ in xEmailObj = xOutlookObj.CreateItem(0)
Med xEmailObj
.Visa
.To = "Ctracklegal@ctrack.com"
.CC = ""
.Subject = "????"
För I = 0 Till UBound(xArrShetts)
On Error Resume Next
.Attachments.Add xArrShetts(I)
Nästa
Om DisplayEmail = False Då
.Skicka
Exit Sub
End If
Sluta med


End Sub
Svara
0
0
Tori
Tori
Denna kommentar minimerades av moderatoren på webbplatsen
Hej @crystal
Det här är fantastiskt - det viktigaste jag kämpar med är filnamnet - jag vill att filnamnet ska hämtas från en cell i kalkylbladet istället för att använda fliknamnet. Jag har redan redigerat koden för att spara automatiskt i en angiven mapp men kämpar med filnamnet.
Någon hjälp du kan erbjuda?
Svara
0
0
kristall
kristall     Tori
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Tori, Om du vill namnge PDF-filen med ett specifikt cellvärde, försök med följande kod. När du har kört koden och valt en mapp för att spara filen, dyker en annan dialogruta upp, välj cellen som du ska använda värdet som namnet på PDF-filen och klicka sedan på OK för att avsluta.
Sub Saveaspdfandsend2()
'Uppdaterad av Extendoffice 20210521
Dim xSht Som arbetsblad
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo Som heltal
Dim xOutlookObj Som objekt
Dim xEmailObj As Object
Dim xUsedRng, xRgInser As Range
Dim xB Som Boolean
Ställ in xSht = ActiveSheet
Ställ in xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Om xFileDlg.Show = Sant då
xFolder = xFileDlg.SelectedItems(1)
annars
MsgBox "Du måste ange en mapp att spara PDF-filen i." & vbCrLf & vbCrLf & "Tryck på OK för att avsluta detta makro.", vbCritical, "Måste ange målmapp"
Exit Sub
End If
xB = Sant
On Error Resume Next
Medan xB
Ställ in xRgInser = Ingenting
Set xRgInser = Application.InputBox("Välj en cell som du ska använda värdet för att namnge PDF-filen:", "Kutools for Excel", , , , , , 8)
Om xRgInser är ingenting då
MsgBox " Ingen cell har valts, avsluta operationen! ", vbInformation, "Kutools för Excel"
Exit Sub
End If
Om xRgInser.Text = "" Då
MsgBox " Den valda cellen är tom, vänligen välj igen! ", vbInformation, "Kutools för Excel"
annars
xB = Falskt
End If
Wend

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

'Kontrollera om filen redan finns
Om Len(Dir(xFolder)) > 0 Då
xYesorNo = MsgBox(xFolder & " finns redan." & vbCrLf & vbCrLf & "Vill du skriva över den?", _
vbYesNo + vbQuestion, "Fil existerar")
On Error Resume Next
Om xYesorNo = vbYes Då
Döda xFolder
annars
MsgBox "om du inte skriver över den befintliga PDF-filen kan jag inte fortsätta." _
& vbCrLf & vbCrLf & "Tryck på OK för att avsluta detta makro.", vbCritical, "Exiting Macro"
Exit Sub
End If
Om Err.Number <> 0 Då
MsgBox "Det gick inte att ta bort befintlig fil. Se till att filen inte är öppen eller skrivskyddad." _
& vbCrLf & vbCrLf & "Tryck på OK för att avsluta detta makro.", vbCritical, "Kan inte ta bort fil"
Exit Sub
End If
End If

Ställ in xUsedRng = xSht.UsedRange
Om Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Då
'Spara som PDF-fil
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filnamn:=xFolder, Quality:=xlQualityStandard

'Skapa Outlook-e-post
Ställ in xOutlookObj = CreateObject("Outlook.Application")
Ställ in xEmailObj = xOutlookObj.CreateItem(0)
Med xEmailObj
.Visa
.Till = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Bilagor.Lägg till xFolder
Om DisplayEmail = False Då
'.Skicka
End If
Sluta med
annars
MsgBox "Det aktiva kalkylbladet kan inte vara tomt"
Exit Sub
End If
End Sub
Svara
Report
0
0
Makeeuropeanu
Makeeuropeanu
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, jag behövde något liknande så här är vad jag fick. Det tar det aktuella datumet och skapar en ny mapp med datumnamnet på en specifik plats. Den placerar pdf:en på den nya platsen och bifogar sedan pdf:en i ett nytt e-postmeddelande. Fungerar som en godbit. Jag är bara en nybörjare så ursäkta mig om det ser ut som en röra. :D
Sub PDFTOEMAIL()
Dim xSht Som arbetsblad
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo Som heltal
Dim xOutlookObj Som objekt
Dim xEmailObj As Object
Dim xUsedRng As Range
Dim xPath som sträng
Dim xOutMsg As String
Dim sFolderName As String, sFolder As String
Dim sFolderPath som sträng

Ställ in xSht = ActiveSheet
xFileDate = Format(Nu, "dd-mm-åååå")
sFolder = "C:" 'här har du en huvudmapp
sFolderName = "Veckans slut " + Format(Nu, "dd-mm-åååå") 'mapp som ska skapas i huvudmappen med namnet Veckans slut och aktuellt datum
sFolderPath = "C:" & sFolderName 'huvudmappen igen för att skapa den nya sökvägen inklusive den nya mappen
Set oFSO = CreateObject("Scripting.FileSystemObject")
Om oFSO.FolderExists(sFolderPath) Då
MsgBox "Mapp finns redan!" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
annars
MkDir sFolderPath
MsgBox "Ny mapp har skapats!" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
End If
xPath = sFolderPath
xFolder = xPath + "\" + xSht.Name + "_" + xFileDate + ".pdf"
Om Len(Dir(xFolder)) > 0 Då
xYesorNo = MsgBox(xFolder & " finns redan." & vbCrLf & vbCrLf & "Vill du skriva över den?", _
vbYesNo + vbQuestion, "Fil existerar")
On Error Resume Next
Om xYesorNo = vbYes Då
Döda xFolder
annars
MsgBox "om du inte skriver över den befintliga PDF-filen kan jag inte fortsätta." _
& vbCrLf & vbCrLf & "Tryck på OK för att avsluta detta makro.", vbCritical, "Exiting Macro"
Exit Sub
End If
Om Err.Number <> 0 Då
MsgBox "Det gick inte att ta bort befintlig fil. Se till att filen inte är öppen eller skrivskyddad." _
& vbCrLf & vbCrLf & "Tryck på OK för att avsluta detta makro.", vbCritical, "Kan inte ta bort fil"
Exit Sub
End If
End If

Ställ in xUsedRng = xSht.UsedRange
Om Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Då
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filnamn:=xFolder, Quality:=xlQualityStandard
Ställ in xOutlookObj = CreateObject("Outlook.Application")
Ställ in xEmailObj = xOutlookObj.CreateItem(0)
xOutMsg = " Se bifogad Detta e-postmeddelande och bilaga har genererats automatiskt "
'lägger till en anteckning om att e-postmeddelandet genererades automatiskt

Med xEmailObj
.Visa
.To = "" 'lägg till dina egna e-postmeddelanden
.CC = ""
.Subject = xSht.Name + " PDF för veckoslut " + xFileDate + " - Plats " ' ämne inkluderar arknamn, pdf, datum och plats, detta kan redigeras efter behov
.Bilagor.Lägg till xFolder
.HTMLBody = xOutMsg & .HTMLBody
Om DisplayEmail = False Då
'.Skicka <--- Här om du tar bort apostrof kommer e-postmeddelandet att skickas automatiskt, så var försiktig
End If
Sluta med
annars
MsgBox "Det aktiva kalkylbladet kan inte vara tomt"
Exit Sub
End If
End Sub
Svara
Report
0
0
Nicole
Nicole
Denna kommentar minimerades av moderatoren på webbplatsen
Hur redigerar jag den här koden för att bara spara celler ("a1:r99") för att spara som PDF. Jag har extra grejer på sidorna som jag inte vill ha i mitt PDF-dokument.
Sub Saveaspdfandsend()
'Uppdaterad av Extendoffice 20210209
Dim xSht Som arbetsblad
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo Som heltal
Dim xOutlookObj Som objekt
Dim xEmailObj As Object
Dim xUsedRng As Range
Dim xStrName As String
Dim xV Som variant

Ställ in xSht = ActiveSheet
Ställ in xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Om xFileDlg.Show = Sant då
xFolder = xFileDlg.SelectedItems(1)
annars
MsgBox "Du måste ange en mapp att spara PDF-filen i." & vbCrLf & vbCrLf & "Tryck på OK för att avsluta detta makro.", vbCritical, "Måste ange målmapp"
Exit Sub
End If
xStrName = ""
xV = Application.InputBox("Ange filnamnet:", "Kutools for Excel", , , , , , 2)
Om xV = Falskt då
Exit Sub
End If
xStrName = xV
Om xStrName = "" Då
MsgBox ("Inget filnamn angett, processen avslutas!")
Exit Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
'Kontrollera om filen redan finns
Om Len(Dir(xFolder)) > 0 Då
xYesorNo = MsgBox(xFolder & " finns redan." & vbCrLf & vbCrLf & "Vill du skriva över den?", _
vbYesNo + vbQuestion, "Fil existerar")
On Error Resume Next
Om xYesorNo = vbYes Då
Döda xFolder
annars
MsgBox "om du inte skriver över den befintliga PDF-filen kan jag inte fortsätta." _
& vbCrLf & vbCrLf & "Tryck på OK för att avsluta detta makro.", vbCritical, "Exiting Macro"
Exit Sub
End If
Om Err.Number <> 0 Då
MsgBox "Det gick inte att ta bort befintlig fil. Se till att filen inte är öppen eller skrivskyddad." _
& vbCrLf & vbCrLf & "Tryck på OK för att avsluta detta makro.", vbCritical, "Kan inte ta bort fil"
Exit Sub
End If
End If

Ställ in xUsedRng = xSht.UsedRange
Om Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Då
'Spara som PDF-fil
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filnamn:=xFolder, Quality:=xlQualityStandard

'Skapa Outlook-e-post
Ställ in xOutlookObj = CreateObject("Outlook.Application")
Ställ in xEmailObj = xOutlookObj.CreateItem(0)
Med xEmailObj
.Visa
.Till = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Bilagor.Lägg till xFolder
Om DisplayEmail = False Då
'.Skicka
End If
Sluta med
annars
MsgBox "Det aktiva kalkylbladet kan inte vara tomt"
Exit Sub
End If
End Sub
Svara
0
0
RLF
RLF     Nicole
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, jag har precis provat den här koden på ett av mina kalkylblad och jag har ställt in utskriftsområden så att de extra sakerna längst ner inte syntes i pdf:en. Försök!
Svara
0
0
Rod Bennett
Rod Bennett
Denna kommentar minimerades av moderatoren på webbplatsen
Hi
Stort tack för koden men är det möjligt att spara PDF-filen automatiskt på samma plats som den aktiva Excel-filen och med samma filnamn som den aktiva Excel-filen?
Många tack.
Stång
Svara
0
0
Det finns inga kommentarer här ännu
Ladda fler
Lämna dina kommentarer
Gäst
Postar som gäst
Logga in
×
Betygsätt detta inlägg:
Återställa
0   Tecken
Föreslagna platser

Följ oss

Copyright © 2009 - www.extendoffice.com. | Alla rättigheter förbehållna. Drivs av ExtendOffice. | | Sitemap
Microsoft och Office-logotypen är varumärken eller registrerade varumärken som tillhör Microsoft Corporation i USA och / eller andra länder.
Skyddad av Sectigo SSL