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

Hogyan menthetünk egy munkalapot PDF fájlként és e-mailben csatolmányként az Outlook segítségével?

Bizonyos esetekben előfordulhat, hogy egy munkalapot PDF fájlként kell elküldenie az Outlook segítségével. Általában manuálisan el kell mentenie a munkalapot PDF fájlként, majd létre kell hoznia egy új e-mailt ezzel a PDF fájllal mellékletként az Outlook programban, és végül el kell küldenie. Időigényes a lépésről lépésre kézi elérése. Ebben a cikkben bemutatjuk, hogyan lehet gyorsan menteni a munkalapot PDF fájlként, és automatikusan elküldeni mellékletként az Outlook programban az Excel programban.

Mentse el a munkalapot PDF fájlként, és e-mailben csatolja VBA kóddal


Mentse el a munkalapot PDF fájlként, és e-mailben csatolja VBA kóddal

Az alábbi VBA kód futtatásával automatikusan mentheti az aktív munkalapot PDF fájlként, majd e-mailben csatolmányként küldheti el az Outlook segítségével. Kérjük, tegye a következőket.

1. Nyissa meg a PDF-ként menteni kívánt munkalapot és küldje el, majd nyomja meg a gombot más + F11 gombok egyszerre a Microsoft Visual Basic for Applications ablak.

2. Ban,-ben Microsoft Visual Basic for Applications ablakban kattintson betétlap > Modulok. Ezután másolja és illessze be az alábbi VBA kódot a Kód ablak. Lásd a képernyőképet:

VBA kód: Munkalap mentése PDF fájlként, és e-mailben csatolásként

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. megnyomni a F5 gombot a kód futtatásához. Ban,-ben Tallózás párbeszédpanelen válasszon egy mappát a PDF fájl mentéséhez, majd kattintson a gombra OK gombot.

Megjegyzések:

1. Most az aktív munkalap PDF fájlként mentésre kerül. A PDF fájl neve pedig a munkalap neve.
2. Ha az aktív munkalap üres, megjelenik egy párbeszédpanel, amint az alábbi képernyőképen látható, miután a gombra kattintott OK gombot.

4. Most létrehoz egy új Outlook e-mailt, és láthatja, hogy a PDF fájl mellékletként szerepel a Csatolt fájlban. Lásd a képernyőképet:

5. Írja össze ezt az e-mailt, majd küldje el.
6. Ez a kód csak akkor érhető el, ha az Outlook programot használja levelezőprogramként.

Könnyen menthet egy munkalapot vagy több munkalapot különálló PDF fájlokként egyszerre:

A Felosztott munkafüzet hasznossága Kutools az Excel számára segítségével könnyebben elmenthet egy munkalapot vagy több munkalapot különálló PDF fájlokként egyszerre, ahogy az alábbi bemutató bemutatja. Töltse le és próbálja ki most! (30-napos ingyenes túra)


Kapcsolódó cikkek:


A legjobb irodai termelékenységi eszközök

A Kutools for Excel megoldja a legtöbb problémát, és 80% -kal növeli a termelékenységet

  • újrafelhasználás: Gyorsan helyezze be összetett képletek, diagramok és bármi, amit korábban használt; Cellák titkosítása jelszóval; Levelezőlista létrehozása és e-maileket küldeni ...
  • Szuper Formula Bár (könnyedén szerkeszthet több szöveget és képletet); Olvasás elrendezés (könnyen olvasható és szerkeszthető nagyszámú cella); Beillesztés a Szűrt tartományba...
  • Cellák / sorok / oszlopok egyesítése az adatok elvesztése nélkül; Osztott cellák tartalma; Kombinálja a duplikált sorokat / oszlopokat... megakadályozza az ismétlődő cellákat; Hasonlítsa össze a tartományokat...
  • Válassza a Másolat vagy az Egyedi lehetőséget Sorok; Válassza az Üres sorok lehetőséget (az összes cella üres); Super Find és Fuzzy Find sok munkafüzetben; Véletlenszerű kiválasztás ...
  • Pontos másolás Több cella a képletreferencia megváltoztatása nélkül; Automatikus referenciák létrehozása több lapra; Helyezze be a golyókat, Jelölőnégyzetek és még sok más ...
  • Kivonat szöveg, Szöveg hozzáadása, Eltávolítás pozíció szerint, Hely eltávolítása; Hozz létre és nyomtasson személyhívó részösszegeket; Konvertálás a cellatartalom és a megjegyzések között...
  • Szuper szűrő (mentse el és alkalmazza a szűrősémákat más lapokra); Haladó rendezés hónap / hét / nap, gyakoriság és egyebek szerint; Speciális szűrő félkövér, dőlt betűvel ...
  • Kombinálja a munkafüzeteket és a munkalapokat; Táblázatok egyesítése kulcsoszlopok alapján; Az adatok felosztása több lapra; Kötegelt konvertálás xls, xlsx és PDF...
  • Több mint 300 hatékony funkció. Támogatja az Office / Excel 2007-2021 és 365 verziókat. Minden nyelvet támogat. Könnyű üzembe helyezés vállalatában vagy szervezetében. Teljes funkciók 30 napos ingyenes próbaverzió. 60 napos pénzvisszafizetési garancia.
kte lap 201905

Az Office fül a füles felületet hozza az Office-ba, és sokkal könnyebbé teszi a munkáját

  • Füles szerkesztés és olvasás engedélyezése Wordben, Excelben és PowerPointban, Publisher, Access, Visio és Project.
  • Több dokumentum megnyitása és létrehozása ugyanazon ablak új lapjain, mint új ablakokban.
  • 50% -kal növeli a termelékenységet, és naponta több száz kattintással csökkenti az egér kattintását!
officetab alja
A megjegyzések rendezése szerint
Hozzászólások (62)
Az 5-t az 5-ből kiértékelte · 1 értékelés
A weboldal moderátora ezt a megjegyzést minimalizálta
Ez remekül működik számomra, de van mód arra, hogy manuális helyett automatikusan válassza ki a mappa helyét? Remélem, egyszerre 40 lapra sikerül.
A weboldal moderátora ezt a megjegyzést minimalizálta
Reméljük, hogy választ kapunk erre a kérdésre is! Köszönöm a segítséget!
A weboldal moderátora ezt a megjegyzést minimalizálta
Megpróbáltam ezt beilleszteni egy új modulba, és fordítási hibaüzenetet kapok: Az al vagy a funkció nincs megadva. Kérem, segítsen.
A weboldal moderátora ezt a megjegyzést minimalizálta
Kedves Darren!
Melyik Office verziót használod?
A weboldal moderátora ezt a megjegyzést minimalizálta
Office 360
A weboldal moderátora ezt a megjegyzést minimalizálta
Ugyanaz a kérdés
A weboldal moderátora ezt a megjegyzést minimalizálta
Hogyan szerkeszthetném a fenti VBA-szkriptet úgy, hogy dátum- és időbélyegzőt adjon a fájlnévhez, így nem írja felül a már mentetteket?
A weboldal moderátora ezt a megjegyzést minimalizálta
Kedves Michael!
Kérjük, futtassa az alábbi VBA kódot a probléma megoldásához.

Sub Saveaspdfandsend()
Dim xSht Munkalapként
Dim xFileDlg mint FileDialog
Dim xFolder As String
Dim xYesorNo Egész számként
Dim xOutlookObj objektumként
Dim xEmailObj objektumként
Dim xUsedRng As Range
Dim xStr As String

Állítsa be az xSht = ActiveSheet
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Ha xFileDlg.Show = igaz, akkor
xFolder = xFileDlg.SelectedItems(1)
Más
MsgBox "Meg kell adnia egy mappát a PDF mentéséhez." & vbCrLf & vbCrLf & "Nyomja meg az OK gombot a makróból való kilépéshez.", vbCritical, "Meg kell adnia a célmappát"
Exit Sub
Ha véget
xStr = Formátum (Most(), "éééé-hh-nn-óó-hh-ss")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'Ellenőrizze, hogy létezik-e már fájl
Ha Len(Dir(xFolder)) > 0 Akkor
xYesorNo = MsgBox(xFolder & " már létezik." & vbCrLf & vbCrLf & "Felülírja?", _
vbYesNo + vbQuestion, "Fájl létezik")
On Error Resume Next
Ha xYesorNo = vbYes Akkor
Öld meg az xFoldert
Más
MsgBox "ha nem írja felül a meglévő PDF-et, nem tudom folytatni." _
& vbCrLf & vbCrLf & "Nyomja meg az OK gombot a makróból való kilépéshez.", vbCritical, "Exiting Macro"
Exit Sub
Ha véget
Ha Err.Number <> 0 Akkor
MsgBox "Nem lehet törölni a meglévő fájlt. Kérjük, győződjön meg arról, hogy a fájl nincs megnyitva vagy nincs írásvédett." _
& vbCrLf & vbCrLf & "Nyomja meg az OK gombot a makróból való kilépéshez.", vbCritical, "Nem sikerült törölni a fájlt"
Exit Sub
Ha véget
Ha véget

Állítsa be: xUsedRng = xSht.UsedRange
Ha Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Akkor
'Mentés PDF fájlként
xSht.ExportAsFixedFormat Type:=xlTypePDF, Fájlnév:=xMappa, Minőség:=xlMinőségszabvány

"Outlook e-mail létrehozása
Set xOutlookObj = CreateObject("Outlook.Application")
xEmailObj = xOutlookObj.CreateItem(0) beállítása
Az xEmailObj segítségével
.Kijelző
.To = ""
.CC = ""
.Subject = xSht.Name + "-" + xStr + ".pdf"
.Attachments.Add xFolder
Ha DisplayEmail = False Akkor
'.Küld
Ha véget
Vége
Más
MsgBox "Az aktív munkalap nem lehet üres"
Exit Sub
Ha véget
End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Crystal,

Nagyon szuper és nekem tökéletesen működik. További segítségre van szüksége a hozzáadáshoz:

1. a "Címzett" mezőben szeretnék hivatkozást adni az aktív lap adott cellájára, mint ahogyan a CC-ben, a BCC-ben pedig szeretnék hozzáadni egy aktív lap hivatkozást
2. az e-mail törzsében meg kell adnom néhány szabványos szöveget.

Nagyon hálás leszek a segítségedért.

Kösz
Parag
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Parag Somani!
Az alábbi VBA kód segíthet. Kérjük, módosítsa a .To, .CC, .BCC és .Body mezőket igényeinek megfelelően.

Sub Saveaspdfandsend()
Dim xSht Munkalapként
Dim xFileDlg mint FileDialog
Dim xFolder As String
Dim xYesorNo Egész számként
Dim xOutlookObj objektumként
Dim xEmailObj objektumként
Dim xUsedRng As Range
Dim xStr As String

Állítsa be az xSht = ActiveSheet
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Ha xFileDlg.Show = igaz, akkor
xFolder = xFileDlg.SelectedItems(1)
Más
MsgBox "Meg kell adnia egy mappát a PDF mentéséhez." & vbCrLf & vbCrLf & "Nyomja meg az OK gombot a makróból való kilépéshez.", vbCritical, "Meg kell adnia a célmappát"
Exit Sub
Ha véget
xStr = Formátum (Most(), "éééé-hh-nn-óó-hh-ss")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'Ellenőrizze, hogy létezik-e már fájl
Ha Len(Dir(xFolder)) > 0 Akkor
xYesorNo = MsgBox(xFolder & " már létezik." & vbCrLf & vbCrLf & "Felülírja?", _
vbYesNo + vbQuestion, "Fájl létezik")
On Error Resume Next
Ha xYesorNo = vbYes Akkor
Öld meg az xFoldert
Más
MsgBox "ha nem írja felül a meglévő PDF-et, nem tudom folytatni." _
& vbCrLf & vbCrLf & "Nyomja meg az OK gombot a makróból való kilépéshez.", vbCritical, "Exiting Macro"
Exit Sub
Ha véget
Ha Err.Number <> 0 Akkor
MsgBox "Nem lehet törölni a meglévő fájlt. Győződjön meg arról, hogy a fájl nincs megnyitva vagy nincs írásvédett." _
& vbCrLf & vbCrLf & "Nyomja meg az OK gombot a makróból való kilépéshez.", vbCritical, "Nem sikerült törölni a fájlt"
Exit Sub
Ha véget
Ha véget

Állítsa be: xUsedRng = xSht.UsedRange
Ha Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Akkor
'Mentés PDF fájlként
xSht.ExportAsFixedFormat Type:=xlTypePDF, Fájlnév:=xMappa, Minőség:=xlMinőségszabvány

"Outlook e-mail létrehozása
Set xOutlookObj = CreateObject("Outlook.Application")
xEmailObj = xOutlookObj.CreateItem(0) beállítása
Az xEmailObj segítségével
.Kijelző
.To = Tartomány("A8")
.CC = Tartomány ("A9")
.BCC = Tartomány("A10")
.Subject = xSht.Name + "-" + xStr + ".pdf"
.Body = "Kedves" _
& vbNewLine & vbNewLine & _
"Ez egy teszt e-mail" & _
"küldés Excelben"
.Attachments.Add xFolder
Ha DisplayEmail = False Akkor
'.Küld
Ha véget
Vége
Más
MsgBox "Az aktív munkalap nem lehet üres"
Exit Sub
Ha véget
End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
Próbáltam a Range-ot használni a "To", "CC"-hez, csak nem veszi fel az értékeket a kijelölt cellából. Tudsz ebben segíteni?
Köszönöm,
Mehul
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Crystal,

Nagyon szuper és nekem tökéletesen működik. További segítségre van szüksége a hozzáadáshoz:

1. a "Címzett" mezőben szeretnék hivatkozást adni az aktív lap adott cellájára, mint ahogyan a CC-ben, a BCC-ben pedig szeretnék hozzáadni egy aktív lap hivatkozást
2. az e-mail törzsében meg kell adnom néhány szabványos szöveget.

Nagyon hálás leszek a segítségedért.

Kösz
Parag
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Crystal,

Nagyon szuper és nekem tökéletesen működik. További segítségre van szüksége a hozzáadáshoz:

1. a "Címzett" mezőben szeretnék hivatkozást adni az aktív lap adott cellájára, mint ahogyan a CC-ben, a BCC-ben pedig szeretnék hozzáadni egy aktív lap hivatkozást
2. az e-mail törzsében meg kell adnom néhány szabványos szöveget.

Nagyon hálás leszek a segítségedért.

Kösz
Parag
A weboldal moderátora ezt a megjegyzést minimalizálta
Hogyan tudom hozzáadni például a 2. lapot a munkafüzetből pdf-ként?
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Armin,
Először meg kell nyitnia a 2. munkalapot a munkafüzetében, majd futtassa a VBA-kódot a fenti lépésekkel a letöltéshez.
A weboldal moderátora ezt a megjegyzést minimalizálta
Hogyan szerkeszthetném a fenti VBA-szkriptet úgy, hogy a fájlnév az aktuális munkalapon belül kiválasztott meghatározott cellaként, például A1 cellaként kerüljön mentésre?
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Tom.
Sajnos ebben nem tudok segíteni.
Üdvözöljük, ha bármilyen kérdést feltehet fórumunkon: https://www.extendoffice.com/forum.html
További Excel-támogatást kaphat az Excel professzionális vagy más Excel rajongóktól.
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia, hogyan tudom elmenteni és elküldeni a pdf-et a munkafüzet nevével az aktuális VBA kóddal? mit használjak az xSht.Name helyett
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia James,
Szeretné elküldeni az aktív munkalapot pdf formátumban, és elnevezni munkafüzet nevének?
A weboldal moderátora ezt a megjegyzést minimalizálta
Köszi működik.
A weboldal moderátora ezt a megjegyzést minimalizálta
Hogyan tudom törölni az elmentett pdf-et, miután elküldte e-mailben?
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Jason,
Sajnos ebben még nem tudok segíteni. Az e-mail elküldése után manuálisan kell törölnie.
A weboldal moderátora ezt a megjegyzést minimalizálta
Helló,

Meg lehet találni a pdf nevét egy cellából? Volt. H4 cella


A H4 cellában pedig azt akarom, hogy három különböző cellából gyűjtsön. Van erre lehetőség?
A weboldal moderátora ezt a megjegyzést minimalizálta
Ez lehetséges. Hozzon létre külön változókat a cellák értékének megtartásához, majd használja ezeket a változókat az xFolder beállításakor.
A munkalapon lévő cellából származó értéket és a mai dátumot használtam. Könnyen megadhat több cellaértéket is.

Ezt tettem hozzá:
Dim xMemberName As String
Dim xFileDate karakterláncként

xMemberName = Tartomány("H3").Érték
xFileDate = Formátum (most, "mm-nn")

xFolder = xFolder + "\" xMemberName + xFileDate + ".pdf"
A weboldal moderátora ezt a megjegyzést minimalizálta
Hibaüzenetet kapok, amikor megpróbálom, hova kell ezt elhelyeznem a kódban?
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Crystal,



Nagyon szuper és nekem tökéletesen működik. További segítségre van szüksége a hozzáadáshoz:

1. a "Body"-ban szeretnék hivatkozást adni az Aktív lap adott cellájára. Tovább szeretné vastagítani a szöveget.

Kösz

Üdvözlettel

Kishore Kumar
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia,

Úgy érted, hogy automatikusan hozzá kell adni a cellaértéket a levéltörzshez, és félkövérre kell szedni? Tegyük fel, hogy hozzáadja a C4 értékét a levél törzséhez. Kérjük, alkalmazza az alábbi kódot.

Sub Saveaspdfandsend()

Dim xSht Munkalapként

Dim xFileDlg mint FileDialog

Dim xFolder As String

Dim xYesorNo Egész számként

Dim xOutlookObj objektumként

Dim xEmailObj objektumként

Dim xUsedRng As Range



Állítsa be az xSht = ActiveSheet

Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)



Ha xFileDlg.Show = igaz, akkor

xFolder = xFileDlg.SelectedItems(1)

Más

MsgBox "Meg kell adnia egy mappát a PDF mentéséhez." & vbCrLf & vbCrLf & "Nyomja meg az OK gombot a makróból való kilépéshez.", vbCritical, "Meg kell adnia a célmappát"

Exit Sub

Ha véget

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



'Ellenőrizze, hogy létezik-e már fájl

Ha Len(Dir(xFolder)) > 0 Akkor

xYesorNo = MsgBox(xFolder & " már létezik." & vbCrLf & vbCrLf & "Felülírja?", _

vbYesNo + vbQuestion, "Fájl létezik")

On Error Resume Next

Ha xYesorNo = vbYes Akkor

Öld meg az xFoldert

Más

MsgBox "ha nem írja felül a meglévő PDF-et, nem tudom folytatni." _

& vbCrLf & vbCrLf & "Nyomja meg az OK gombot a makróból való kilépéshez.", vbCritical, "Exiting Macro"

Exit Sub

Ha véget

Ha Err.Number <> 0 Akkor

MsgBox "Nem lehet törölni a meglévő fájlt. Győződjön meg arról, hogy a fájl nincs megnyitva vagy nincs írásvédett." _

& vbCrLf & vbCrLf & "Nyomja meg az OK gombot a makróból való kilépéshez.", vbCritical, "Nem sikerült törölni a fájlt"

Exit Sub

Ha véget

Ha véget



Állítsa be: xUsedRng = xSht.UsedRange

Ha Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Akkor

'Mentés PDF fájlként

xSht.ExportAsFixedFormat Type:=xlTypePDF, Fájlnév:=xMappa, Minőség:=xlMinőségszabvány



"Outlook e-mail létrehozása

Set xOutlookObj = CreateObject("Outlook.Application")

xEmailObj = xOutlookObj.CreateItem(0) beállítása

Az xEmailObj segítségével

.Kijelző

.To = ""

.CC = ""

.Subject = xSht.Name + ".pdf"

.Attachments.Add xFolder

.HTMLBody = "
" & Tartomány("C4") & .HTMLBody

Ha DisplayEmail = False Akkor

'.Küld

Ha véget

Vége

Más

MsgBox "Az aktív munkalap nem lehet üres"

Exit Sub

Ha véget

End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
Ha azt szeretném, hogy minden alkalommal egy adott mappába menjen automatikusan (ezáltal nincs szükség arra, hogy a felhasználónak kiválassza a mappát), hogyan tenném?
Volt. C: Számlák/Észak-Amerika/Ügyfelek
A segítséget nagyra értékeljük.
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Geoff!
A munkalap mentése pdf fájlként, és elküldés nélkül egy adott mappába való mentése?
A weboldal moderátora ezt a megjegyzést minimalizálta
Úgy gondolom, hogy Geoff azt jelenti, hogy minden alkalommal meg kell adni egy adott mappát a kódban, amelybe a pdf-fájl mentésre kerül, ahelyett, hogy manuálisan kellene kiválasztani a helyet. A pdf-et ezután e-mailben küldik el az adott mappából.
A weboldal moderátora ezt a megjegyzést minimalizálta
Köszönöm Jeremy.
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Geoff! Ha a pdf fájlt automatikusan egy adott mappába szeretné menteni, ahelyett, hogy manuálisan választaná ki a helyet, próbálja meg az alábbi kódot. Ne felejtse el megváltoztatni a mappa elérési útját a kódban.
Sub SaveAsPDFandSend()
Dim xSht Munkalapként
Dim xFileDlg mint FileDialog
Dim xFolder As String
Dim xYesorNo Egész számként
Dim xOutlookObj objektumként
Dim xEmailObj objektumként
Dim xUsedRng As Range
Dim xPath As String
Állítsa be az xSht = ActiveSheet
xPath = "C:\Users\Win10x64Test\Desktop\munkalap pdf-be" 'Itt a "munkalap pdf-be" a célmappa a pdf fájlok mentéséhez
xFolder = xPath + "\" + xSht.Name + ".pdf"
Ha Len(Dir(xFolder)) > 0 Akkor
xYesorNo = MsgBox(xFolder & " már létezik." & vbCrLf & vbCrLf & "Felülírja?", _
vbYesNo + vbQuestion, "Fájl létezik")
On Error Resume Next
Ha xYesorNo = vbYes Akkor
Öld meg az xFoldert
Más
MsgBox "ha nem írja felül a meglévő PDF-et, nem tudom folytatni." _
& vbCrLf & vbCrLf & "Nyomja meg az OK gombot a makróból való kilépéshez.", vbCritical, "Exiting Macro"
Exit Sub
Ha véget
Ha Err.Number <> 0 Akkor
MsgBox "Nem lehet törölni a meglévő fájlt. Győződjön meg arról, hogy a fájl nincs megnyitva vagy nincs írásvédett." _
& vbCrLf & vbCrLf & "Nyomja meg az OK gombot a makróból való kilépéshez.", vbCritical, "Nem sikerült törölni a fájlt"
Exit Sub
Ha véget
Ha véget

Állítsa be: xUsedRng = xSht.UsedRange
Ha Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Akkor
'Mentés PDF fájlként
xSht.ExportAsFixedFormat Type:=xlTypePDF, Fájlnév:=xMappa, Minőség:=xlMinőségszabvány

"Outlook e-mail létrehozása
Set xOutlookObj = CreateObject("Outlook.Application")
xEmailObj = xOutlookObj.CreateItem(0) beállítása
Az xEmailObj segítségével
.Kijelző
.To = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Add xFolder
Ha DisplayEmail = False Akkor
'.Küld
Ha véget
Vége
Más
MsgBox "Az aktív munkalap nem lehet üres"
Exit Sub
Ha véget
End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
Ez a kód remekül működik, kivéve, hogy a munkalapot a munkalapnév + dátum néven szeretném elmenteni (pl. 1. munkalap 1. október 2020.); a felhasználó asztalán (ezt többen fogják használni, és az útvonaluk kissé eltérhet). Ha lehetséges, szeretnék egy .jpg-t is beágyazni a törzsbe.. a JPG mind a munkalapon belül található (a nyomtatási területen kívül), mind a kép egy megosztott szerveren van tárolva.. bár a szerver elérési útja eltérő felhasználó (a legtöbb számára "T" meghajtó, néhány "U" meghajtó)
ezt meg lehet csinálni? kérlek és milliószor köszönöm.
A weboldal moderátora ezt a megjegyzést minimalizálta

Szia, remekül működik, köszönöm a megosztást, csak egy segítségre van szüksége.
Ha személyre szabott névvel akarok menteni egy PDF-fájlt (a fájlnév beírása a Mentés másként párbeszédpanelen), használja ezt a lehetőséget az űrlapsablonban, ahol az űrlapok PDF-ként menthetők egyedi néven.
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia! Kérjük, próbálja ki az alábbi VBA kódot. A kód futtatása után válasszon ki egy mappát a PDF-fájl mentéséhez, majd egy párbeszédpanel jelenik meg, ahol megadhatja a fájl nevét. Sub Saveaspdfandsend()
'Frissítette Extendoffice 20210209
Dim xSht Munkalapként
Dim xFileDlg mint FileDialog
Dim xFolder As String
Dim xYesorNo Egész számként
Dim xOutlookObj objektumként
Dim xEmailObj objektumként
Dim xUsedRng As Range
Dim xStrName As String
Dim xV mint Variant

Állítsa be az xSht = ActiveSheet
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Ha xFileDlg.Show = igaz, akkor
xFolder = xFileDlg.SelectedItems(1)
Más
MsgBox "Meg kell adnia egy mappát a PDF mentéséhez." & vbCrLf & vbCrLf & "Nyomja meg az OK gombot a makróból való kilépéshez.", vbCritical, "Meg kell adnia a célmappát"
Exit Sub
Ha véget
xStrName = ""
xV = Application.InputBox("Kérjük, adja meg a fájlnevet:", "Kutools for Excel", , , , , , 2)
Ha xV = hamis Akkor
Exit Sub
Ha véget
xStrName = xV
Ha xStrName = "" Akkor
MsgBox ("Nincs fájlnév megadva, kilép a folyamatból!")
Exit Sub
Ha véget

xFolder = xFolder + "\" + xStrName + ".pdf"
'Ellenőrizze, hogy létezik-e már fájl
Ha Len(Dir(xFolder)) > 0 Akkor
xYesorNo = MsgBox(xFolder & " már létezik." & vbCrLf & vbCrLf & "Felülírja?", _
vbYesNo + vbQuestion, "Fájl létezik")
On Error Resume Next
Ha xYesorNo = vbYes Akkor
Öld meg az xFoldert
Más
MsgBox "ha nem írja felül a meglévő PDF-et, nem tudom folytatni." _
& vbCrLf & vbCrLf & "Nyomja meg az OK gombot a makróból való kilépéshez.", vbCritical, "Exiting Macro"
Exit Sub
Ha véget
Ha Err.Number <> 0 Akkor
MsgBox "Nem lehet törölni a meglévő fájlt. Győződjön meg arról, hogy a fájl nincs megnyitva vagy nincs írásvédett." _
& vbCrLf & vbCrLf & "Nyomja meg az OK gombot a makróból való kilépéshez.", vbCritical, "Nem sikerült törölni a fájlt"
Exit Sub
Ha véget
Ha véget

Állítsa be: xUsedRng = xSht.UsedRange
Ha Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Akkor
'Mentés PDF fájlként
xSht.ExportAsFixedFormat Type:=xlTypePDF, Fájlnév:=xMappa, Minőség:=xlMinőségszabvány

"Outlook e-mail létrehozása
Set xOutlookObj = CreateObject("Outlook.Application")
xEmailObj = xOutlookObj.CreateItem(0) beállítása
Az xEmailObj segítségével
.Kijelző
.To = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Add xFolder
Ha DisplayEmail = False Akkor
'.Küld
Ha véget
Vége
Más
MsgBox "Az aktív munkalap nem lehet üres"
Exit Sub
Ha véget
End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia,
Ha két lap van a fájlban, és szeretném futtatni ezt a makrót az egyik lapon (a gomb megnyomásával), de egy másikat küldök, hogyan szerezhetem meg?
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia! Szeretném elmenteni ezt egy bizonyos fájlhelyre, a C30-as cellában lévő értéken alapuló névvel. Kipróbáltam néhány lehetőséget, de folyamatosan kapnak hibákat.
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia hein, az alábbi kód talán segíthet. A kód futtatása után válasszon ki egy bizonyos mappát a PDF fájl mentéséhez, majd egy párbeszédpanel jelenik meg, ahol megadhatja a fájl nevét. Sub Saveaspdfandsend()
'Frissítette Extendoffice 20210209
Dim xSht Munkalapként
Dim xFileDlg mint FileDialog
Dim xFolder As String
Dim xYesorNo Egész számként
Dim xOutlookObj objektumként
Dim xEmailObj objektumként
Dim xUsedRng As Range
Dim xStrName As String
Dim xV mint Variant

Állítsa be az xSht = ActiveSheet
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Ha xFileDlg.Show = igaz, akkor
xFolder = xFileDlg.SelectedItems(1)
Más
MsgBox "Meg kell adnia egy mappát a PDF mentéséhez." & vbCrLf & vbCrLf & "Nyomja meg az OK gombot a makróból való kilépéshez.", vbCritical, "Meg kell adnia a célmappát"
Exit Sub
Ha véget
xStrName = ""
xV = Application.InputBox("Kérjük, adja meg a fájlnevet:", "Kutools for Excel", , , , , , 2)
Ha xV = hamis Akkor
Exit Sub
Ha véget
xStrName = xV
Ha xStrName = "" Akkor
MsgBox ("Nincs fájlnév megadva, kilép a folyamatból!")
Exit Sub
Ha véget

xFolder = xFolder + "\" + xStrName + ".pdf"
'Ellenőrizze, hogy létezik-e már fájl
Ha Len(Dir(xFolder)) > 0 Akkor
xYesorNo = MsgBox(xFolder & " már létezik." & vbCrLf & vbCrLf & "Felülírja?", _
vbYesNo + vbQuestion, "Fájl létezik")
On Error Resume Next
Ha xYesorNo = vbYes Akkor
Öld meg az xFoldert
Más
MsgBox "ha nem írja felül a meglévő PDF-et, nem tudom folytatni." _
& vbCrLf & vbCrLf & "Nyomja meg az OK gombot a makróból való kilépéshez.", vbCritical, "Exiting Macro"
Exit Sub
Ha véget
Ha Err.Number <> 0 Akkor
MsgBox "Nem lehet törölni a meglévő fájlt. Győződjön meg arról, hogy a fájl nincs megnyitva vagy nincs írásvédett." _
& vbCrLf & vbCrLf & "Nyomja meg az OK gombot a makróból való kilépéshez.", vbCritical, "Nem sikerült törölni a fájlt"
Exit Sub
Ha véget
Ha véget

Állítsa be: xUsedRng = xSht.UsedRange
Ha Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Akkor
'Mentés PDF fájlként
xSht.ExportAsFixedFormat Type:=xlTypePDF, Fájlnév:=xMappa, Minőség:=xlMinőségszabvány

"Outlook e-mail létrehozása
Set xOutlookObj = CreateObject("Outlook.Application")
xEmailObj = xOutlookObj.CreateItem(0) beállítása
Az xEmailObj segítségével
.Kijelző
.To = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Add xFolder
Ha DisplayEmail = False Akkor
'.Küld
Ha véget
Vége
Más
MsgBox "Az aktív munkalap nem lehet üres"
Exit Sub
Ha véget
End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
Köszönet érte, ez nagyszerű, de szeretném, ha a munkalapot az 1. lap A1 cellája szerint neveznék el. A mentés helye a 1. lap A2-es cellája szerint, például C:\Users\peete\Dropbox\Screenshots, és e-mail küldése a következő címre: email címet a 3. A2-as lapon, amit már kidolgoztam.
A weboldal moderátora ezt a megjegyzést minimalizálta
Köszönet érte, ez nagyszerű, de szeretném, ha a munkalapot az 1. lap A1 cellájának megfelelően neveznék el. A mentés helye a 1. lap A2-es cellája szerint, például C:\Users\peete\Dropbox\Screenshots, de módosítható, amikor a fájl segítségével, és e-mailben küldje el a 3. A2-as lapon lévő e-mail címre, amit már kidolgoztam.
A weboldal moderátora ezt a megjegyzést minimalizálta
Hi kristály- , kiváló kód, köszönöm a megosztást.Választhat több lapot (ugyanabból a munkafüzetből), hogy mindegyiket független PDF-fájlként mentse, majd csatolva küldje el egy e-mailben?
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia! Az alábbi VBA-kód tehet egy szívességet. Kérjük, próbálja meg. A kód tizenkettedik sorában cserélje ki a lapneveket a tényleges lapnevekre.
Sub Saveaspdfandsend1()
Dim xSht Munkalapként
Dim xFileDlg mint FileDialog
Dim xFolder As String
Dim xYesorNo, I, xNum As Integer
Dim xOutlookObj objektumként
Dim xEmailObj objektumként
Dim xUsedRng As Range
Dim xArrShetts As Variant
Dim xPDFNameAddress As String
Dim xStr As String
xArrShetts = Array("teszt", "1. lap", "2. lap") „Írja be a pdf-fájlként elküldendő lapneveket idézőjelek közé, és válassza el őket vesszővel. Győződjön meg arról, hogy a fájlnévben nincsenek speciális karakterek, például \/:"*<>|.

Ha I = 0 - UBound(xArrShetts)
On Error Resume Next
Set xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))
Ha xSht.Name <> xArrShetts(I) Akkor
MsgBox "A munkalap nem található, kilépési művelet:" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
Exit Sub
Ha véget
Következő


Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
Ha xFileDlg.Show = igaz, akkor
xFolder = xFileDlg.SelectedItems(1)
Más
MsgBox "Meg kell adnia egy mappát a PDF mentéséhez." & vbCrLf & vbCrLf & "Nyomja meg az OK gombot a makróból való kilépéshez.", vbCritical, "Meg kell adnia a célmappát"
Exit Sub
Ha véget
'Ellenőrizze, hogy létezik-e már fájl
xYesorNo = MsgBox("Ha a célmappában vannak azonos nevű fájlok, akkor a program automatikusan számutódot ad a fájlnévhez a másolatok megkülönböztetése érdekében" & vbCrLf & vbCrLf & "A folytatáshoz kattintson az Igen gombra, a megszakításhoz kattintson a Nem gombra", _
vbYesNo + vbQuestion, "Fájl létezik")
Ha xIgenNem <> vbYes, akkor lépjen ki a Sub
Ha I = 0 - UBound(xArrShetts)
Set xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
xNum = 1
Míg nem (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xNum = xNum + 1
Irányít
Állítsa be: xUsedRng = xSht.UsedRange
Ha Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Akkor
xSht.ExportAsFixedFormat Type:=xlTypePDF, Fájlnév:=xStr, Minőség:=xlMinőségszabvány
Más

Ha véget
xArrShetts(I) = xStr
Következő

"Outlook e-mail létrehozása
Set xOutlookObj = CreateObject("Outlook.Application")
xEmailObj = xOutlookObj.CreateItem(0) beállítása
Az xEmailObj segítségével
.Kijelző
.To = ""
.CC = ""
.Subject = "????"
Ha I = 0 - UBound(xArrShetts)
.Attachments.Add xArrShetts(I)
Következő
Ha DisplayEmail = False Akkor
'.Küld
Ha véget
Vége
End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia! Az egyetlen változtatás, amivel küszködöm, az az, hogy minden létrehozott pdf-dokumentumhoz külön e-mailt hozzak létre.
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia! Ha minden pdf-dokumentumhoz külön e-mailt szeretne létrehozni, manuálisan futtathatja a bejegyzésben található VBA-t különböző munkalapokon.
A weboldal moderátora ezt a megjegyzést minimalizálta
Több mint 100 munkalap van a munkafüzetben, ami azt jelenti, hogy több mint 100-szor kell futtatnom a VBA-t, ami időigényes.  
Sikerült felosztanom a munkafüzetet több lapra, majd minden munkalapot egyedi PDF dokumentummá konvertálhatok.
A megoldás, amit keresek, az, hogy minden PDF-dokumentumot külön e-mailben küldök el, miközben a fenti folyamat fut.
Itt van az általam jelenleg használt VBA:
Sub Saveaspdfandsend1()
Dim xSht Munkalapként
Dim xFileDlg mint FileDialog
Dim xFolder As String
Dim xYesorNo, I, xNum As Integer
Dim xOutlookObj objektumként
Dim xEmailObj objektumként
Dim xUsedRng As Range
Dim xArrShetts As 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") "Írja be a pdf-fájlként küldendő lapneveket idézőjelbe, és válassza el őket vesszővel. Győződjön meg arról, hogy a fájlnévben nincsenek speciális karakterek, például \/:"*<>|.

Ha I = 0 - UBound(xArrShetts)
On Error Resume Next
Set xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))
Ha xSht.Name <> xArrShetts(I) Akkor
MsgBox "A munkalap nem található, kilépési művelet:" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
Exit Sub
Ha véget
Következő


Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
Ha xFileDlg.Show = igaz, akkor
xFolder = xFileDlg.SelectedItems(1)
Más
MsgBox "Meg kell adnia egy mappát a PDF mentéséhez." & vbCrLf & vbCrLf & "Nyomja meg az OK gombot a makróból való kilépéshez.", vbCritical, "Meg kell adnia a célmappát"
Exit Sub
Ha véget
'Ellenőrizze, hogy létezik-e már fájl
xYesorNo = MsgBox("Ha a célmappában vannak azonos nevű fájlok, akkor a program automatikusan számutódot ad a fájlnévhez a másolatok megkülönböztetése érdekében" & vbCrLf & vbCrLf & "A folytatáshoz kattintson az Igen gombra, a megszakításhoz kattintson a Nem gombra", _
vbYesNo + vbQuestion, "Fájl létezik")
Ha xIgenNem <> vbYes, akkor lépjen ki a Sub
Ha I = 0 - UBound(xArrShetts)
Set xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
xNum = 1
Míg nem (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xNum = xNum + 1
Irányít
Állítsa be: xUsedRng = xSht.UsedRange
Ha Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Akkor
xSht.ExportAsFixedFormat Type:=xlTypePDF, Fájlnév:=xStr, Minőség:=xlMinőségszabvány
Más

Ha véget
xArrShetts(I) = xStr
Következő

"Outlook e-mail létrehozása
Set xOutlookObj = CreateObject("Outlook.Application")
xEmailObj = xOutlookObj.CreateItem(0) beállítása
Az xEmailObj segítségével
.Kijelző
.To = "Ctracklegal@ctrack.com"
.CC = ""
.Subject = "????"
Ha I = 0 - UBound(xArrShetts)
On Error Resume Next
.Attachments.Add xArrShetts(I)
Következő
Ha DisplayEmail = False Akkor
.Küld
Exit Sub
Ha véget
Vége


End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia @crystal
Ez nagyszerű – a legfontosabb dolog, amivel küzdök, az a fájlnév – szeretném, ha a fájlnév a munkalap egyik cellájából származna, nem pedig a lap neve. Már szerkesztettem a kódot, hogy automatikusan mentse a megadott mappába, de bajban vagyok a fájlnévvel.
Valami segítséget tudna ajánlani?
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Tori! Ha egy adott cellaértékkel szeretné elnevezni a PDF fájlt, próbálkozzon a következő kóddal. A kód futtatása és a fájl mentéséhez szükséges mappa kiválasztása után egy másik párbeszédpanel jelenik meg, válassza ki a használni kívánt cellát. az értéket a PDF-fájl neveként, majd a befejezéshez kattintson az OK gombra.
Sub Saveaspdfandsend2()
'Frissítette Extendoffice 20210521
Dim xSht Munkalapként
Dim xFileDlg mint FileDialog
Dim xFolder As String
Dim xYesorNo Egész számként
Dim xOutlookObj objektumként
Dim xEmailObj objektumként
Dim xUsedRng, xRgInser As Range
Dim xB Boolean
Állítsa be az xSht = ActiveSheet
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Ha xFileDlg.Show = igaz, akkor
xFolder = xFileDlg.SelectedItems(1)
Más
MsgBox "Meg kell adnia egy mappát a PDF mentéséhez." & vbCrLf & vbCrLf & "Nyomja meg az OK gombot a makróból való kilépéshez.", vbCritical, "Meg kell adnia a célmappát"
Exit Sub
Ha véget
xB = igaz
On Error Resume Next
Míg xB
Állítsa be az xRgInser = Semmit
Set xRgInser = Application.InputBox("Válasszon ki egy cellát, amelyben az értéket fogja használni a PDF-fájl elnevezéséhez:", "Kutools for Excel", , , , , , 8)
Ha az xRgInser semmi, akkor
MsgBox " Nincs cella kiválasztva, lépjen ki a műveletből! ", vbInformation, "Kutools for Excel"
Exit Sub
Ha véget
Ha xRgInser.Text = "" Akkor
MsgBox " A kijelölt cella üres, kérjük, válasszon újra! ", vbInformation, "Kutools for Excel"
Más
xB = hamis
Ha véget
Irányít

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

'Ellenőrizze, hogy létezik-e már fájl
Ha Len(Dir(xFolder)) > 0 Akkor
xYesorNo = MsgBox(xFolder & " már létezik." & vbCrLf & vbCrLf & "Felülírja?", _
vbYesNo + vbQuestion, "Fájl létezik")
On Error Resume Next
Ha xYesorNo = vbYes Akkor
Öld meg az xFoldert
Más
MsgBox "ha nem írja felül a meglévő PDF-et, nem tudom folytatni." _
& vbCrLf & vbCrLf & "Nyomja meg az OK gombot a makróból való kilépéshez.", vbCritical, "Exiting Macro"
Exit Sub
Ha véget
Ha Err.Number <> 0 Akkor
MsgBox "Nem lehet törölni a meglévő fájlt. Győződjön meg arról, hogy a fájl nincs megnyitva vagy nincs írásvédett." _
& vbCrLf & vbCrLf & "Nyomja meg az OK gombot a makróból való kilépéshez.", vbCritical, "Nem sikerült törölni a fájlt"
Exit Sub
Ha véget
Ha véget

Állítsa be: xUsedRng = xSht.UsedRange
Ha Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Akkor
'Mentés PDF fájlként
xSht.ExportAsFixedFormat Type:=xlTypePDF, Fájlnév:=xMappa, Minőség:=xlMinőségszabvány

"Outlook e-mail létrehozása
Set xOutlookObj = CreateObject("Outlook.Application")
xEmailObj = xOutlookObj.CreateItem(0) beállítása
Az xEmailObj segítségével
.Kijelző
.To = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Add xFolder
Ha DisplayEmail = False Akkor
'.Küld
Ha véget
Vége
Más
MsgBox "Az aktív munkalap nem lehet üres"
Exit Sub
Ha véget
End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia, valami hasonlóra volt szükségem, ezért ezt kaptam. Az aktuális dátumot veszi, és egy új mappát hoz létre a dátum nevével egy adott helyen. A PDF-et az új helyre helyezi, majd csatolja a PDF-et egy új e-mailhez. Csemegeként működik. Még csak kezdő vagyok, ezért elnézést kérek, ha rendetlenségnek tűnik. :D
Sub PDFTOEMAIL()
Dim xSht Munkalapként
Dim xFileDlg mint FileDialog
Dim xFolder As String
Dim xYesorNo Egész számként
Dim xOutlookObj objektumként
Dim xEmailObj objektumként
Dim xUsedRng As Range
Dim xPath As String
Dim xOutMsg As String
Dim sFolderName As String, sFolder As String
Dim sFolderPath karakterláncként

Állítsa be az xSht = ActiveSheet
xFileDate = Formátum (most, "nn-hh-éééé")
sFolder = "C:" 'itt van egy főmappája
sFolderName = "Hét vége" + Formátum(most, "nn-hh-éééé") 'mappa létrehozása a fő mappában Hét vége és aktuális dátummal
sFolderPath = "C:" & sFolderName 'főmappa újra az új elérési út létrehozásához, beleértve az új mappát
Set oFSO = CreateObject("Scripting.FileSystemObject")
Ha oFSO.FolderExists(sFolderPath) Akkor
MsgBox "Már létezik mappa!" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
Más
MkDir sFolderPath
MsgBox "Új mappa jött létre!" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
Ha véget
xPath = sFolderPath
xFolder = xPath + "\" + xSht.Name + "_" + xFileDate + ".pdf"
Ha Len(Dir(xFolder)) > 0 Akkor
xYesorNo = MsgBox(xFolder & " már létezik." & vbCrLf & vbCrLf & "Felülírja?", _
vbYesNo + vbQuestion, "Fájl létezik")
On Error Resume Next
Ha xYesorNo = vbYes Akkor
Öld meg az xFoldert
Más
MsgBox "ha nem írja felül a meglévő PDF-et, nem tudom folytatni." _
& vbCrLf & vbCrLf & "Nyomja meg az OK gombot a makróból való kilépéshez.", vbCritical, "Exiting Macro"
Exit Sub
Ha véget
Ha Err.Number <> 0 Akkor
MsgBox "Nem lehet törölni a meglévő fájlt. Győződjön meg arról, hogy a fájl nincs megnyitva vagy nincs írásvédett." _
& vbCrLf & vbCrLf & "Nyomja meg az OK gombot a makróból való kilépéshez.", vbCritical, "Nem sikerült törölni a fájlt"
Exit Sub
Ha véget
Ha véget

Állítsa be: xUsedRng = xSht.UsedRange
Ha Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Akkor
xSht.ExportAsFixedFormat Type:=xlTypePDF, Fájlnév:=xMappa, Minőség:=xlMinőségszabvány
Set xOutlookObj = CreateObject("Outlook.Application")
xEmailObj = xOutlookObj.CreateItem(0) beállítása
xOutMsg = " Mellékelve találja Ez az e-mail és a melléklet automatikusan létrejött "
'megjegyzi, hogy az e-mail automatikusan jött létre

Az xEmailObj segítségével
.Kijelző
.To = "" 'adja hozzá saját e-mailjeit
.CC = ""
.Subject = xSht.Name + " PDF a hét végéhez " + xFileDate + " - Location " ' tárgy tartalmazza a munkalap nevét, pdf-jét, dátumát és helyét, ez szükség szerint szerkeszthető
.Attachments.Add xFolder
.HTMLBody = xOutMsg & .HTMLBody
Ha DisplayEmail = False Akkor
'.Küldés <--- Itt ha törli az aposztrófot, az e-mail automatikusan elküldésre kerül, ezért legyen óvatos
Ha véget
Vége
Más
MsgBox "Az aktív munkalap nem lehet üres"
Exit Sub
Ha véget
End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
Hogyan szerkeszthetem ezt a kódot úgy, hogy csak a cellákat ("a1:r99") mentse el PDF-ként. Az oldalakon extra cuccok vannak, amelyeket nem szeretnék a PDF-dokumentumban.
Sub Saveaspdfandsend()
'Frissítette Extendoffice 20210209
Dim xSht Munkalapként
Dim xFileDlg mint FileDialog
Dim xFolder As String
Dim xYesorNo Egész számként
Dim xOutlookObj objektumként
Dim xEmailObj objektumként
Dim xUsedRng As Range
Dim xStrName As String
Dim xV mint Variant

Állítsa be az xSht = ActiveSheet
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Ha xFileDlg.Show = igaz, akkor
xFolder = xFileDlg.SelectedItems(1)
Más
MsgBox "Meg kell adnia egy mappát a PDF mentéséhez." & vbCrLf & vbCrLf & "Nyomja meg az OK gombot a makróból való kilépéshez.", vbCritical, "Meg kell adnia a célmappát"
Exit Sub
Ha véget
xStrName = ""
xV = Application.InputBox("Kérjük, adja meg a fájlnevet:", "Kutools for Excel", , , , , , 2)
Ha xV = hamis Akkor
Exit Sub
Ha véget
xStrName = xV
Ha xStrName = "" Akkor
MsgBox ("Nincs fájlnév megadva, kilép a folyamatból!")
Exit Sub
Ha véget

xFolder = xFolder + "\" + xStrName + ".pdf"
'Ellenőrizze, hogy létezik-e már fájl
Ha Len(Dir(xFolder)) > 0 Akkor
xYesorNo = MsgBox(xFolder & " már létezik." & vbCrLf & vbCrLf & "Felülírja?", _
vbYesNo + vbQuestion, "Fájl létezik")
On Error Resume Next
Ha xYesorNo = vbYes Akkor
Öld meg az xFoldert
Más
MsgBox "ha nem írja felül a meglévő PDF-et, nem tudom folytatni." _
& vbCrLf & vbCrLf & "Nyomja meg az OK gombot a makróból való kilépéshez.", vbCritical, "Exiting Macro"
Exit Sub
Ha véget
Ha Err.Number <> 0 Akkor
MsgBox "Nem lehet törölni a meglévő fájlt. Győződjön meg arról, hogy a fájl nincs megnyitva vagy nincs írásvédett." _
& vbCrLf & vbCrLf & "Nyomja meg az OK gombot a makróból való kilépéshez.", vbCritical, "Nem sikerült törölni a fájlt"
Exit Sub
Ha véget
Ha véget

Állítsa be: xUsedRng = xSht.UsedRange
Ha Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Akkor
'Mentés PDF fájlként
xSht.ExportAsFixedFormat Type:=xlTypePDF, Fájlnév:=xMappa, Minőség:=xlMinőségszabvány

"Outlook e-mail létrehozása
Set xOutlookObj = CreateObject("Outlook.Application")
xEmailObj = xOutlookObj.CreateItem(0) beállítása
Az xEmailObj segítségével
.Kijelző
.To = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Add xFolder
Ha DisplayEmail = False Akkor
'.Küld
Ha véget
Vége
Más
MsgBox "Az aktív munkalap nem lehet üres"
Exit Sub
Ha véget
End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
Helló, most próbáltam ki ezt a kódot az egyik munkalapomon, és beállítottam a nyomtatási területeket, így az alján lévő extra dolgok nem jelentek meg a pdf-ben. Próbáld ki!
A weboldal moderátora ezt a megjegyzést minimalizálta
Hi
Köszönjük a kódot, de lehetséges-e a PDF-fájl automatikus mentése ugyanoda, ahol az aktív Excel fájl, és ugyanazzal a névvel, mint az aktív Excel fájl?
Nagyon köszönöm.
rúd
Még senki sem írt megjegyzést
Több ingatlan
Hagyja meg észrevételeit
Feladás vendégként
×
Értékeld ezt a bejegyzést:
0   Karakterek
Javasolt helyek

Kövess minket

Copyright © 2009 - www.extendoffice.com. | Minden jog fenntartva. Powered by ExtendOffice. | Oldaltérkép
A Microsoft és az Office logó a Microsoft Corporation védjegyei vagy bejegyzett védjegyei az Egyesült Államokban és / vagy más országokban.
Sectigo SSL védi