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

Elképesztő! Hatékony lapok használata az Excelben, például a Chrome, a Firefox és a Safari!

Takarítsa meg idejének 50% -át, és csökkentse az egérkattintások ezreit minden nap!

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.

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.

Tovább ... Ingyenes letöltés... Vásárlás...

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!

Tovább ... Ingyenes letöltés... Vásárlás...

Hozzászólások (62)

Az 5-t az 5-ből kiértékelte · 1 értékelés

Michael

körülbelül 5 éve

#20277

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.

Válasz

Hugh Michael

körülbelül 2 éve

#20278

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!

Válasz

Darren

körülbelül 5 éve

#22279

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.

Válasz

kristály- Darren

körülbelül 5 éve

#22280

A weboldal moderátora ezt a megjegyzést minimalizálta

Kedves Darren!
Melyik Office verziót használod?

Válasz

Jelentés

Nakia kristály-

körülbelül 4 éve

#22281

A weboldal moderátora ezt a megjegyzést minimalizálta

Office 360

Válasz

Számla Darren

körülbelül 3 éve

#22282

A weboldal moderátora ezt a megjegyzést minimalizálta

Ugyanaz a kérdés

Válasz

Michael Charry

körülbelül 4 éve

#24346

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?

Válasz

Jelentés

kristály- Michael Charry

körülbelül 4 éve

#24347

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

Válasz

Jelentés

Parag Somani kristály-

körülbelül 3 éve

#24348

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

Válasz

kristály- Parag Somani

körülbelül 3 éve

#24349

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

Válasz

Jelentés

Mehul kristály-

mintegy 10 hónappal ezelőtt

#24350

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

Válasz

Parag Somani kristály-

körülbelül 3 éve

#24351

A weboldal moderátora ezt a megjegyzést minimalizálta

Válasz

Parag kristály-

körülbelül 3 éve

#24352

A weboldal moderátora ezt a megjegyzést minimalizálta

Válasz

Jelentés

Armin

körülbelül 4 éve

#24839

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?

Válasz

kristály- Armin

körülbelül 4 éve

#24840

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.

Válasz

Jelentés

Tom h

körülbelül 4 éve

#25005

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?

Válasz

kristály- Tom h

körülbelül 4 éve

#25006

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.

Válasz

Jelentés

james

körülbelül 4 éve

#26183

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

Válasz

kristály- james

körülbelül 4 éve

#26184

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?

Válasz

Jelentés

Berendezések

körülbelül 3 éve

#29450

A weboldal moderátora ezt a megjegyzést minimalizálta

Köszi működik.

Válasz

Jason

körülbelül 3 éve

#29502

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?

Válasz

kristály- Jason

körülbelül 3 éve

#29503

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.

Válasz

Jelentés

Odd-Inge

körülbelül 3 éve

#30839

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?

Válasz

Taylor Odd-Inge

körülbelül 2 éve

#30840

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"

Válasz

Sora Taylor

mintegy 4 hónappal ezelőtt

#40196

A weboldal moderátora ezt a megjegyzést minimalizálta

Hibaüzenetet kapok, amikor megpróbálom, hova kell ezt elhelyeznem a kódban?

Válasz

Kishore

körülbelül 2 éve

#32506

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

Válasz

Jelentés

kristály- Kishore

körülbelül 2 éve

#32507

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

Válasz

Jelentés

Geoff

körülbelül 2 éve

#33679

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.

Válasz

kristály- Geoff

körülbelül 2 éve

#33680

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?

Válasz

Jelentés

Jeremy kristály-

körülbelül 2 éve

#33681

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.

Válasz

kristály- Jeremy

körülbelül 2 éve

#33682

A weboldal moderátora ezt a megjegyzést minimalizálta

Köszönöm Jeremy.

Válasz

Jelentés

kristály- Geoff

körülbelül 2 éve

#33683

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

Válasz

Jelentés

Alison

körülbelül 2 éve

#34153

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.

Válasz

Deepak

mintegy 1 éve

#34748

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.

Válasz

Jelentés

kristály- Deepak

mintegy 1 éve

#34749

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

Válasz

Jelentés

mlecrus94

mintegy 1 éve

#35017

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?

Válasz

Jelentés

huh

mintegy 1 éve

#35061

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.

Válasz

kristály- huh

mintegy 1 éve

#35062

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

Válasz

Jelentés

Hein kristály-

mintegy 1 éve

#35063

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.

Válasz

HeinPeeters kristály-

mintegy 1 éve

#35064

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.

Válasz

Jelentés

BenSpo

mintegy 1 éve

#35283

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?

Válasz

Jelentés

kristály- BenSpo

mintegy 1 éve

#35284

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

Válasz

Jelentés

Berné Rudolph kristály-

mintegy 1 éve

#35285

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.

Válasz

kristály- Berné Rudolph

mintegy 1 éve

#35286

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.

Válasz

Jelentés

Berné Rudolph kristály-

mintegy 1 éve

#35287

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

Válasz

Tori

mintegy 1 éve

#35336

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?

Válasz

kristály- Tori

mintegy 1 éve

#35337

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

Válasz

Jelentés

Make Europeanu

mintegy 1 éve

#35342

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

Válasz

Jelentés

Nicole

mintegy 1 éve

#35677

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

Válasz

RLF Nicole

mintegy 1 éve

#35678

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!

Válasz

Rod Bennett

mintegy 1 éve

#35699

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

Válasz

Még senki sem írt megjegyzést

Több ingatlan

Hagyja meg észrevételeit

Feladás vendégként

Bejelentkezés

Név (kötelező)

Email (szükséges)

Értékeld ezt a bejegyzést:

vissza

0 Karakterek

Egyetértek azzal, hogy a szabályait és feltételeit