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

Bagaimana cara menyimpan lembar kerja sebagai file PDF dan mengirimkannya melalui email sebagai lampiran melalui Outlook?

Dalam beberapa kasus, Anda mungkin perlu mengirim lembar kerja sebagai file PDF melalui Outlook. Biasanya, Anda harus menyimpan lembar kerja secara manual sebagai file PDF, lalu membuat email baru dengan file PDF ini sebagai lampiran di Outlook Anda dan akhirnya mengirimkannya. Butuh waktu lama untuk mencapainya secara manual langkah demi langkah. Pada artikel ini, kami akan menunjukkan cara cepat menyimpan lembar kerja sebagai file PDF dan mengirimkannya secara otomatis sebagai lampiran melalui Outlook di Excel.

Simpan lembar kerja sebagai file PDF dan kirimkan melalui email sebagai lampiran dengan kode VBA


Simpan lembar kerja sebagai file PDF dan kirimkan melalui email sebagai lampiran dengan kode VBA


Anda dapat menjalankan kode VBA di bawah ini untuk secara otomatis menyimpan lembar kerja aktif sebagai file PDF, lalu mengirimkannya melalui email sebagai lampiran melalui Outlook. Silakan lakukan sebagai berikut.

1. Buka lembar kerja yang akan Anda simpan sebagai PDF dan kirim, lalu tekan lain + F11 tombol secara bersamaan untuk membuka Microsoft Visual Basic untuk Aplikasi jendela.

2. Dalam Microsoft Visual Basic untuk Aplikasi window, klik Menyisipkan > Modul. Kemudian salin dan tempel kode VBA di bawah ini ke file Kode jendela. Lihat tangkapan layar:

Kode VBA: Simpan lembar kerja sebagai file PDF dan kirimkan melalui email sebagai lampiran

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. tekan F5 kunci untuk menjalankan kode. Dalam Browse kotak dialog, pilih folder untuk menyimpan file PDF ini, lalu klik OK .

Catatan:

1. Sekarang lembar kerja aktif disimpan sebagai file PDF. Dan file PDF diberi nama dengan nama lembar kerja.
2. Jika lembar kerja aktif kosong, Anda akan mendapatkan kotak dialog seperti gambar di bawah ini setelah mengklik OK .

4. Sekarang email Outlook baru dibuat dan Anda dapat melihat file PDF terdaftar sebagai lampiran di kolom Terlampir. Lihat tangkapan layar:

5. Silakan tulis email ini dan kemudian kirimkan.
6. Kode ini hanya tersedia saat Anda menggunakan Outlook sebagai program email Anda.

Simpan lembar kerja atau beberapa lembar kerja dengan mudah sebagai file PDF terpisah sekaligus:

The Pisahkan Buku Kerja kegunaan Kutools untuk Excel dapat membantu Anda dengan mudah menyimpan lembar kerja atau beberapa lembar kerja sebagai file PDF terpisah sekaligus seperti yang ditunjukkan demo di bawah ini. Unduh dan coba sekarang! (Jejak gratis 30 hari)


Terkait artikel:


Alat Produktivitas Kantor Terbaik

Kutools for Excel Memecahkan Sebagian Besar Masalah Anda, dan Meningkatkan Produktivitas Anda hingga 80%

  • Reuse: Masukkan dengan cepat rumus, bagan yang kompleks dan apa pun yang pernah Anda gunakan sebelumnya; Enkripsi Sel dengan kata sandi; Buat Milis dan mengirim email ...
  • Bilah Formula Super (dengan mudah mengedit beberapa baris teks dan rumus); Membaca Tata Letak (membaca dan mengedit sel dalam jumlah besar dengan mudah); Tempel ke Rentang yang Difilter...
  • Gabungkan Sel / Baris / Kolom tanpa kehilangan Data; Pisahkan Konten Sel; Gabungkan Baris / Kolom Duplikat... Mencegah Sel Duplikat; Bandingkan Rentang...
  • Pilih Duplikat atau Unik Baris; Pilih Baris Kosong (semua sel kosong); Temukan Super dan Temukan Fuzzy di Banyak Buku Kerja; Pilih Acak ...
  • Salinan Tepat Beberapa Sel tanpa mengubah referensi rumus; Buat Referensi Otomatis ke Beberapa Lembar; Sisipkan Poin, Kotak Centang, dan lainnya ...
  • Ekstrak Teks, Tambahkan Teks, Hapus berdasarkan Posisi, Hapus Space; Membuat dan Mencetak Subtotal Paging; Konversi Konten Antar Sel dan Komentar...
  • Filter Super (simpan dan terapkan skema filter ke sheet lain); Penyortiran Lanjutan menurut bulan / minggu / hari, frekuensi dan lainnya; Filter Khusus dengan huruf tebal, miring ...
  • Gabungkan Workbooks dan WorkSheets; Gabungkan Tabel berdasarkan kolom kunci; Pisahkan Data menjadi Beberapa Lembar; Konversi Batch xls, xlsx dan PDF...
  • Lebih dari 300 fitur canggih. Mendukung Office / Excel 2007-2019 dan 365. Mendukung semua bahasa. Penerapan yang mudah di perusahaan atau organisasi Anda. Fitur lengkap uji coba gratis 30 hari. Jaminan uang kembali 60 hari.
tab kte 201905

Tab Office Membawa antarmuka Tab ke Office, dan Membuat Pekerjaan Anda Jauh Lebih Mudah

  • Aktifkan pengeditan dan pembacaan tab di Word, Excel, PowerPoint, Publisher, Access, Visio, dan Project.
  • Buka dan buat banyak dokumen di tab baru di jendela yang sama, bukan di jendela baru.
  • Tingkatkan produktivitas Anda hingga 50%, dan kurangi ratusan klik mouse untuk Anda setiap hari!
officetab bawah
Urutkan komentar berdasarkan
komentar (61)
Rated 5 dari 5 · peringkat 1
Komentar ini diminimalkan oleh moderator di situs
Ini berfungsi dengan baik untuk saya, tetapi apakah ada cara untuk memilih lokasi folder secara otomatis daripada memilih secara manual? Saya berharap untuk melakukan ini untuk 40 lembar sekaligus.
Komentar ini diminimalkan oleh moderator di situs
Juga berharap untuk melihat jawaban untuk masalah ini! Terima kasih untuk bantuannya!
Komentar ini diminimalkan oleh moderator di situs
Saya telah mencoba menempelkan ini ke modul baru dan saya mendapatkan kesalahan Kompilasi: Sub atau Fungsi tidak ditentukan. Tolong bantu.
Komentar ini diminimalkan oleh moderator di situs
Darren sayang,
Versi Office mana yang Anda gunakan?
Komentar ini diminimalkan oleh moderator di situs
kantor 360
Komentar ini diminimalkan oleh moderator di situs
Masalah yang sama
Komentar ini diminimalkan oleh moderator di situs
Bagaimana saya mengedit skrip VBA di atas sehingga menambahkan cap tanggal dan waktu ke nama file sehingga tidak terus menimpa apa yang sudah disimpan?
Komentar ini diminimalkan oleh moderator di situs
Untuk Michael,
Silakan jalankan kode VBA di bawah ini untuk menyelesaikan masalah.

Sub Simpan sebagaipdfandsend()
Redupkan xSht Sebagai Lembar Kerja
Redupkan xFileDlg Sebagai FileDialog
Redupkan xFolder Sebagai String
Redupkan xYesorNo As Integer
Redupkan xOutlookObj Sebagai Objek
Redupkan xEmailObj Sebagai Objek
Redupkan xUsedRng Sebagai Rentang
Redupkan xStr Sebagai String

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

Jika xFileDlg.Show = Benar Maka
xFolder = xFileDlg.SelectedItems(1)
Lain
MsgBox "Anda harus menentukan folder untuk menyimpan PDF." & vbCrLf & vbCrLf & "Tekan OK untuk keluar dari makro ini.", vbCritical, "Harus Tentukan Folder Tujuan"
Keluar dari Sub
End If
xStr = Format(Sekarang(), "yyyy-mm-dd-hh-mm-ss")
xFolder = xFolder + "\" + xSht.Nama + "-" + xStr + ".pdf"

'Periksa apakah file sudah ada
Jika Len(Dir(xFolder)) > 0 Maka
xYesorNo = MsgBox(xFolder & " sudah ada." & vbCrLf & vbCrLf & "Apakah Anda ingin menimpanya?", _
vbYesNo + vbQuestion, "File Ada")
On Error Resume Next
Jika xYesorNo = vbYa Maka
Bunuh xFolder
Lain
MsgBox "jika Anda tidak menimpa PDF yang ada, saya tidak dapat melanjutkan." _
& vbCrLf & vbCrLf & "Tekan OK untuk keluar dari makro ini.", vbCritical, "Keluar dari Makro"
Keluar dari Sub
End If
Jika Err.Number <> 0 Maka
MsgBox "Tidak dapat menghapus file yang ada. Pastikan file tidak terbuka atau tidak dilindungi penulisan." _
& vbCrLf & vbCrLf & "Tekan OK untuk keluar dari makro ini.", vbCritical, "Tidak Dapat Menghapus File"
Keluar dari Sub
End If
End If

Setel xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Kemudian
'Simpan sebagai file PDF
xSht.ExportAsFixedFormat Jenis:=xlTypePDF, Nama File:=xFolder, Kualitas:=xlQualityStandard

'Buat email Outlook
Setel xOutlookObj = CreateObject("Outlook.Application")
Setel xEmailObj = xOutlookObj.CreateItem(0)
Dengan xEmailObj
.Tampilan
.Untuk = ""
.CC = ""
.Subjek = xSht.Nama + "-" + xStr + ".pdf"
.Lampiran.Tambahkan xFolder
Jika DisplayEmail = Salah Kemudian
'.Kirim
End If
Berakhir dengan
Lain
MsgBox "Lembar kerja yang aktif tidak boleh kosong"
Keluar dari Sub
End If
End Sub
Komentar ini diminimalkan oleh moderator di situs
Hai Kristal,

Ini benar-benar hebat dan bekerja dengan sempurna untuk saya. Perlu lebih banyak bantuan untuk menambahkan:

1. di "Ke" saya ingin memberikan tautan ke sel tertentu dari lembar Aktif seperti bijak di CC dan di BCC saya ingin menambahkan tautan lembar aktif
2. di badan email saya perlu menentukan beberapa teks standar.

Saya akan sangat berterima kasih kepada Anda atas bantuan Anda.

Terima kasih
paragraf
Komentar ini diminimalkan oleh moderator di situs
Hai Parag Somani,
Kode VBA di bawah ini dapat membantu Anda. Silakan ubah bidang .To, .CC, .BCC dan .Body berdasarkan kebutuhan Anda.

Sub Simpan sebagaipdfandsend()
Redupkan xSht Sebagai Lembar Kerja
Redupkan xFileDlg Sebagai FileDialog
Redupkan xFolder Sebagai String
Redupkan xYesorNo As Integer
Redupkan xOutlookObj Sebagai Objek
Redupkan xEmailObj Sebagai Objek
Redupkan xUsedRng Sebagai Rentang
Redupkan xStr Sebagai String

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

Jika xFileDlg.Show = Benar Maka
xFolder = xFileDlg.SelectedItems(1)
Lain
MsgBox "Anda harus menentukan folder untuk menyimpan PDF." & vbCrLf & vbCrLf & "Tekan OK untuk keluar dari makro ini.", vbCritical, "Harus Tentukan Folder Tujuan"
Keluar dari Sub
End If
xStr = Format(Sekarang(), "yyyy-mm-dd-hh-mm-ss")
xFolder = xFolder + "\" + xSht.Nama + "-" + xStr + ".pdf"

'Periksa apakah file sudah ada
Jika Len(Dir(xFolder)) > 0 Maka
xYesorNo = MsgBox(xFolder & " sudah ada." & vbCrLf & vbCrLf & "Apakah Anda ingin menimpanya?", _
vbYesNo + vbQuestion, "File Ada")
On Error Resume Next
Jika xYesorNo = vbYa Maka
Bunuh xFolder
Lain
MsgBox "jika Anda tidak menimpa PDF yang ada, saya tidak dapat melanjutkan." _
& vbCrLf & vbCrLf & "Tekan OK untuk keluar dari makro ini.", vbCritical, "Keluar dari Makro"
Keluar dari Sub
End If
Jika Err.Number <> 0 Maka
MsgBox "Tidak dapat menghapus file yang ada. Pastikan file tidak terbuka atau tidak dilindungi penulisan." _
& vbCrLf & vbCrLf & "Tekan OK untuk keluar dari makro ini.", vbCritical, "Tidak Dapat Menghapus File"
Keluar dari Sub
End If
End If

Setel xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Kemudian
'Simpan sebagai file PDF
xSht.ExportAsFixedFormat Jenis:=xlTypePDF, Nama File:=xFolder, Kualitas:=xlQualityStandard

'Buat email Outlook
Setel xOutlookObj = CreateObject("Outlook.Application")
Setel xEmailObj = xOutlookObj.CreateItem(0)
Dengan xEmailObj
.Tampilan
.Ke = Rentang("A8")
.CC = Rentang("A9")
.BCC = Rentang("A10")
.Subjek = xSht.Nama + "-" + xStr + ".pdf"
.Tubuh = "Sayang" _
& vbNewLine & vbNewLine & _
"Ini adalah email percobaan" & _
"mengirim di excel"
.Lampiran.Tambahkan xFolder
Jika DisplayEmail = Salah Kemudian
'.Kirim
End If
Berakhir dengan
Lain
MsgBox "Lembar kerja yang aktif tidak boleh kosong"
Keluar dari Sub
End If
End Sub
Komentar ini diminimalkan oleh moderator di situs
Saya telah mencoba menggunakan Rentang untuk "Ke", "CC", hanya saja tidak mengambil nilai dari sel yang ditunjuk. Bisakah Anda membantu dalam hal ini?
Terima kasih,
Mehul
Komentar ini diminimalkan oleh moderator di situs
Hai Kristal,

Ini benar-benar hebat dan bekerja dengan sempurna untuk saya. Perlu lebih banyak bantuan untuk menambahkan:

1. di "Ke" saya ingin memberikan tautan ke sel tertentu dari lembar Aktif seperti bijak di CC dan di BCC saya ingin menambahkan tautan lembar aktif
2. di badan email saya perlu menentukan beberapa teks standar.

Saya akan sangat berterima kasih kepada Anda atas bantuan Anda.

Terima kasih
paragraf
Komentar ini diminimalkan oleh moderator di situs
Hai Kristal,

Ini benar-benar hebat dan bekerja dengan sempurna untuk saya. Perlu lebih banyak bantuan untuk menambahkan:

1. di "Ke" saya ingin memberikan tautan ke sel tertentu dari lembar Aktif seperti bijak di CC dan di BCC saya ingin menambahkan tautan lembar aktif
2. di badan email saya perlu menentukan beberapa teks standar.

Saya akan sangat berterima kasih kepada Anda atas bantuan Anda.

Terima kasih
paragraf
Komentar ini diminimalkan oleh moderator di situs
Bagaimana saya bisa menambahkan misalnya lembar 2 dari buku kerja sebagai pdf?
Komentar ini diminimalkan oleh moderator di situs
Hai Armin,
Anda perlu membuka Lembar 2 di buku kerja Anda terlebih dahulu dan kemudian jalankan kode VBA dengan langkah-langkah di atas untuk menurunkannya.
Komentar ini diminimalkan oleh moderator di situs
Bagaimana cara mengedit skrip VBA di atas sehingga nama file disimpan sebagai sel tertentu yang dipilih dalam lembar saat ini, misalnya sel A1?
Komentar ini diminimalkan oleh moderator di situs
Hai Tom.
Maaf tidak bisa membantu dengan ini.
Selamat datang untuk memposting pertanyaan apa pun di forum kami: https://www.extendoffice.com/forum.html
Anda akan mendapatkan lebih banyak dukungan Excel dari profesional Excel atau penggemar Excel lainnya.
Komentar ini diminimalkan oleh moderator di situs
Hai, bagaimana saya bisa menyimpan & mengirim pdf dengan nama buku kerja dengan kode VBA saat ini? apa yang saya gunakan daripada xSht.Name
Komentar ini diminimalkan oleh moderator di situs
Hi James,
Apakah Anda ingin mengirim lembar kerja aktif sebagai pdf dan menamainya sebagai nama buku kerja?
Komentar ini diminimalkan oleh moderator di situs
Terima kasih itu bekerja.
Komentar ini diminimalkan oleh moderator di situs
Bagaimana saya bisa membuatnya menghapus pdf yang disimpan setelah mengirimkannya melalui email?
Komentar ini diminimalkan oleh moderator di situs
Hi Jason,
Maaf belum bisa membantu Anda. Anda perlu menghapusnya secara manual setelah mengirim email.
Komentar ini diminimalkan oleh moderator di situs
Halo,

Apakah mungkin menemukan nama untuk pdf dari sel? Mantan. Sel H4


Dan di Sel H4 saya ingin mengumpulkan dari tiga sel yang berbeda. Apakah ini mungkin?
Komentar ini diminimalkan oleh moderator di situs
Ini mungkin. Buat variabel terpisah untuk menyimpan nilai dari sel dan kemudian gunakan variabel tersebut saat mengatur xFolder.
Saya menggunakan nilai dari sel di lembar saya ditambah tanggal hari ini. Anda dapat dengan mudah melakukan beberapa nilai sel.

Inilah yang saya tambahkan:
Redupkan xMemberName Sebagai String
Redupkan xFileDate Sebagai String

xMemberName = Range("H3").Nilai
xFileDate = Format(Sekarang, "mm-dd")

xFolder = xFolder + "\" xMemberName + xFileDate + ".pdf"
Komentar ini diminimalkan oleh moderator di situs
Saya mendapatkan kesalahan ketika saya mencoba ini, di mana dalam kode saya harus menempatkan ini?
Komentar ini diminimalkan oleh moderator di situs
Hai Kristal,



Ini benar-benar hebat dan bekerja dengan sempurna untuk saya. Perlu lebih banyak bantuan untuk menambahkan:

1. di "Body" saya ingin memberikan tautan ke sel tertentu dari lembar Aktif. Selanjutnya Ingin Menebalkan teks.

Terima kasih

Salam

Kishore Kumar
Komentar ini diminimalkan oleh moderator di situs
Hai,

Maksud Anda menambahkan nilai sel secara otomatis ke badan surat dan menebalkannya? Misalkan Anda menambahkan nilai C4 ke badan surat. Silakan terapkan kode di bawah ini.

Sub Simpan sebagaipdfandsend()

Redupkan xSht Sebagai Lembar Kerja

Redupkan xFileDlg Sebagai FileDialog

Redupkan xFolder Sebagai String

Redupkan xYesorNo As Integer

Redupkan xOutlookObj Sebagai Objek

Redupkan xEmailObj Sebagai Objek

Redupkan xUsedRng Sebagai Rentang



Setel xSht = ActiveSheet

Setel xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)



Jika xFileDlg.Show = Benar Maka

xFolder = xFileDlg.SelectedItems(1)

Lain

MsgBox "Anda harus menentukan folder untuk menyimpan PDF." & vbCrLf & vbCrLf & "Tekan OK untuk keluar dari makro ini.", vbCritical, "Harus Tentukan Folder Tujuan"

Keluar dari Sub

End If

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



'Periksa apakah file sudah ada

Jika Len(Dir(xFolder)) > 0 Maka

xYesorNo = MsgBox(xFolder & " sudah ada." & vbCrLf & vbCrLf & "Apakah Anda ingin menimpanya?", _

vbYesNo + vbQuestion, "File Ada")

On Error Resume Next

Jika xYesorNo = vbYa Maka

Bunuh xFolder

Lain

MsgBox "jika Anda tidak menimpa PDF yang ada, saya tidak dapat melanjutkan." _

& vbCrLf & vbCrLf & "Tekan OK untuk keluar dari makro ini.", vbCritical, "Keluar dari Makro"

Keluar dari Sub

End If

Jika Err.Number <> 0 Maka

MsgBox "Tidak dapat menghapus file yang ada. Pastikan file tidak terbuka atau tidak dilindungi penulisan." _

& vbCrLf & vbCrLf & "Tekan OK untuk keluar dari makro ini.", vbCritical, "Tidak Dapat Menghapus File"

Keluar dari Sub

End If

End If



Setel xUsedRng = xSht.UsedRange

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

'Simpan sebagai file PDF

xSht.ExportAsFixedFormat Jenis:=xlTypePDF, Nama File:=xFolder, Kualitas:=xlQualityStandard



'Buat email Outlook

Setel xOutlookObj = CreateObject("Outlook.Application")

Setel xEmailObj = xOutlookObj.CreateItem(0)

Dengan xEmailObj

.Tampilan

.Untuk = ""

.CC = ""

.Subjek = xSht.Nama + ".pdf"

.Lampiran.Tambahkan xFolder

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

Jika DisplayEmail = Salah Kemudian

'.Kirim

End If

Berakhir dengan

Lain

MsgBox "Lembar kerja yang aktif tidak boleh kosong"

Keluar dari Sub

End If

End Sub
Komentar ini diminimalkan oleh moderator di situs
Jika saya ingin menyimpannya secara otomatis di folder tertentu setiap saat (menghilangkan kebutuhan pengguna untuk memilih folder), bagaimana saya melakukannya?
Mantan. C: Faktur/Amerika Utara/Klien
Bantuan sangat dihargai.
Komentar ini diminimalkan oleh moderator di situs
Hai Geoff,
Apakah maksud Anda menyimpan lembar kerja sebagai file pdf dan menyimpan ke folder tertentu tanpa mengirim?
Komentar ini diminimalkan oleh moderator di situs
Saya pikir Geoff berarti dapat menentukan folder tertentu dalam kode tempat pdf disimpan setiap kali daripada harus memilih lokasi secara manual. Pdf tersebut kemudian diemail dari folder tertentu.
Komentar ini diminimalkan oleh moderator di situs
Terima kasih jeremy.
Komentar ini diminimalkan oleh moderator di situs
Hai Geoff,Jika Anda ingin menyimpan file pdf secara otomatis ke folder tertentu daripada memilih lokasi secara manual, silakan coba kode di bawah ini. Jangan lupa untuk mengubah jalur folder dalam kode.
Sub SaveAsPDFandSend()
Redupkan xSht Sebagai Lembar Kerja
Redupkan xFileDlg Sebagai FileDialog
Redupkan xFolder Sebagai String
Redupkan xYesorNo As Integer
Redupkan xOutlookObj Sebagai Objek
Redupkan xEmailObj Sebagai Objek
Redupkan xUsedRng Sebagai Rentang
Redupkan xPath Sebagai String
Setel xSht = ActiveSheet
xPath = "C:\Users\Win10x64Test\Desktop\worksheet ke pdf" 'ini "workshet to pdf" adalah folder tujuan untuk menyimpan file pdf
xFolder = xPath + "\" + xSht.Name + ".pdf"
Jika Len(Dir(xFolder)) > 0 Maka
xYesorNo = MsgBox(xFolder & " sudah ada." & vbCrLf & vbCrLf & "Apakah Anda ingin menimpanya?", _
vbYesNo + vbQuestion, "File Ada")
On Error Resume Next
Jika xYesorNo = vbYa Maka
Bunuh xFolder
Lain
MsgBox "jika Anda tidak menimpa PDF yang ada, saya tidak dapat melanjutkan." _
& vbCrLf & vbCrLf & "Tekan OK untuk keluar dari makro ini.", vbCritical, "Keluar dari Makro"
Keluar dari Sub
End If
Jika Err.Number <> 0 Maka
MsgBox "Tidak dapat menghapus file yang ada. Pastikan file tidak terbuka atau tidak dilindungi penulisan." _
& vbCrLf & vbCrLf & "Tekan OK untuk keluar dari makro ini.", vbCritical, "Tidak Dapat Menghapus File"
Keluar dari Sub
End If
End If

Setel xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Kemudian
'Simpan sebagai file PDF
xSht.ExportAsFixedFormat Jenis:=xlTypePDF, Nama File:=xFolder, Kualitas:=xlQualityStandard

'Buat email Outlook
Setel xOutlookObj = CreateObject("Outlook.Application")
Setel xEmailObj = xOutlookObj.CreateItem(0)
Dengan xEmailObj
.Tampilan
.Untuk = ""
.CC = ""
.Subjek = xSht.Nama + ".pdf"
.Lampiran.Tambahkan xFolder
Jika DisplayEmail = Salah Kemudian
'.Kirim
End If
Berakhir dengan
Lain
MsgBox "Lembar kerja yang aktif tidak boleh kosong"
Keluar dari Sub
End If
End Sub
Komentar ini diminimalkan oleh moderator di situs
Kode ini berfungsi dengan baik kecuali saya ingin lembar kerja disimpan sebagai nama lembar + tanggal (mis. Sheet1 1 Okt 2020); di desktop pengguna (ini akan digunakan oleh banyak orang dan jalur mereka mungkin sedikit berbeda). Jika memungkinkan, saya ingin menyematkan .jpg ke dalam tubuh juga.. JPG terletak di dalam lembar kerja (di luar area cetak) dan gambar disimpan di server bersama.. meskipun jalur ke server bervariasi menurut pengguna (untuk sebagian besar itu adalah drive "T" untuk beberapa drive "U")
ini bisa dilakukan? tolong dan terima kasih jutaan kali.
Komentar ini diminimalkan oleh moderator di situs

Hai , ini berfungsi dengan baik terima kasih telah berbagi, Hanya butuh satu bantuan.
Jika saya ingin menyimpan file PDF dengan nama yang disesuaikan (opsi untuk mengetikkan nama file di kotak dialog SaveAs), karena pengguna menggunakan opsi ini di Templat formulir di mana formulir disimpan sebagai PDF dengan nama unik.
Komentar ini diminimalkan oleh moderator di situs
Hai, Silakan coba kode VBA di bawah ini. Setelah menjalankan kode, pilih folder untuk menyimpan file PDF, kemudian akan muncul kotak dialog untuk Anda memasukkan nama file. Sub Simpan sebagaipdfandsend()
'Diperbaharui oleh Extendoffice 20210209
Redupkan xSht Sebagai Lembar Kerja
Redupkan xFileDlg Sebagai FileDialog
Redupkan xFolder Sebagai String
Redupkan xYesorNo As Integer
Redupkan xOutlookObj Sebagai Objek
Redupkan xEmailObj Sebagai Objek
Redupkan xUsedRng Sebagai Rentang
Redupkan xStrName Sebagai String
Redup xV Sebagai Varian

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

Jika xFileDlg.Show = Benar Maka
xFolder = xFileDlg.SelectedItems(1)
Lain
MsgBox "Anda harus menentukan folder untuk menyimpan PDF." & vbCrLf & vbCrLf & "Tekan OK untuk keluar dari makro ini.", vbCritical, "Harus Tentukan Folder Tujuan"
Keluar dari Sub
End If
xStrName = ""
xV = Application.InputBox("Silakan masukkan nama file:", "Kutools for Excel", , , , , , 2)
Jika xV = Salah Maka
Keluar dari Sub
End If
xStrNama = xV
Jika xStrName = "" Maka
MsgBox ("Tidak ada nama file yang dimasukkan, proses keluar!")
Keluar dari Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
'Periksa apakah file sudah ada
Jika Len(Dir(xFolder)) > 0 Maka
xYesorNo = MsgBox(xFolder & " sudah ada." & vbCrLf & vbCrLf & "Apakah Anda ingin menimpanya?", _
vbYesNo + vbQuestion, "File Ada")
On Error Resume Next
Jika xYesorNo = vbYa Maka
Bunuh xFolder
Lain
MsgBox "jika Anda tidak menimpa PDF yang ada, saya tidak dapat melanjutkan." _
& vbCrLf & vbCrLf & "Tekan OK untuk keluar dari makro ini.", vbCritical, "Keluar dari Makro"
Keluar dari Sub
End If
Jika Err.Number <> 0 Maka
MsgBox "Tidak dapat menghapus file yang ada. Pastikan file tidak terbuka atau tidak dilindungi penulisan." _
& vbCrLf & vbCrLf & "Tekan OK untuk keluar dari makro ini.", vbCritical, "Tidak Dapat Menghapus File"
Keluar dari Sub
End If
End If

Setel xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Kemudian
'Simpan sebagai file PDF
xSht.ExportAsFixedFormat Jenis:=xlTypePDF, Nama File:=xFolder, Kualitas:=xlQualityStandard

'Buat email Outlook
Setel xOutlookObj = CreateObject("Outlook.Application")
Setel xEmailObj = xOutlookObj.CreateItem(0)
Dengan xEmailObj
.Tampilan
.Untuk = ""
.CC = ""
.Subjek = xSht.Nama + ".pdf"
.Lampiran.Tambahkan xFolder
Jika DisplayEmail = Salah Kemudian
'.Kirim
End If
Berakhir dengan
Lain
MsgBox "Lembar kerja yang aktif tidak boleh kosong"
Keluar dari Sub
End If
End Sub
Komentar ini diminimalkan oleh moderator di situs
Hai,
Jika saya memiliki dua lembar dalam file, dan saya ingin menjalankan makro ini pada satu lembar (dengan menekan tombol) tetapi mengirim yang lain, bagaimana saya bisa mendapatkannya?
Komentar ini diminimalkan oleh moderator di situs
Halo, saya ingin menyimpan ini di lokasi file tertentu, dengan nama berdasarkan nilai di sel C30. Saya telah mencoba beberapa opsi, tetapi tetap mendapatkan kesalahan.
Komentar ini diminimalkan oleh moderator di situs
Hai hein, Kode di bawah ini mungkin bisa membantu. Setelah menjalankan kode, pilih folder tertentu untuk menyimpan file PDF, kemudian akan muncul kotak dialog untuk Anda memasukkan nama file. Sub Simpan sebagaipdfandsend()
'Diperbaharui oleh Extendoffice 20210209
Redupkan xSht Sebagai Lembar Kerja
Redupkan xFileDlg Sebagai FileDialog
Redupkan xFolder Sebagai String
Redupkan xYesorNo As Integer
Redupkan xOutlookObj Sebagai Objek
Redupkan xEmailObj Sebagai Objek
Redupkan xUsedRng Sebagai Rentang
Redupkan xStrName Sebagai String
Redup xV Sebagai Varian

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

Jika xFileDlg.Show = Benar Maka
xFolder = xFileDlg.SelectedItems(1)
Lain
MsgBox "Anda harus menentukan folder untuk menyimpan PDF." & vbCrLf & vbCrLf & "Tekan OK untuk keluar dari makro ini.", vbCritical, "Harus Tentukan Folder Tujuan"
Keluar dari Sub
End If
xStrName = ""
xV = Application.InputBox("Silakan masukkan nama file:", "Kutools for Excel", , , , , , 2)
Jika xV = Salah Maka
Keluar dari Sub
End If
xStrNama = xV
Jika xStrName = "" Maka
MsgBox ("Tidak ada nama file yang dimasukkan, proses keluar!")
Keluar dari Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
'Periksa apakah file sudah ada
Jika Len(Dir(xFolder)) > 0 Maka
xYesorNo = MsgBox(xFolder & " sudah ada." & vbCrLf & vbCrLf & "Apakah Anda ingin menimpanya?", _
vbYesNo + vbQuestion, "File Ada")
On Error Resume Next
Jika xYesorNo = vbYa Maka
Bunuh xFolder
Lain
MsgBox "jika Anda tidak menimpa PDF yang ada, saya tidak dapat melanjutkan." _
& vbCrLf & vbCrLf & "Tekan OK untuk keluar dari makro ini.", vbCritical, "Keluar dari Makro"
Keluar dari Sub
End If
Jika Err.Number <> 0 Maka
MsgBox "Tidak dapat menghapus file yang ada. Pastikan file tidak terbuka atau tidak dilindungi penulisan." _
& vbCrLf & vbCrLf & "Tekan OK untuk keluar dari makro ini.", vbCritical, "Tidak Dapat Menghapus File"
Keluar dari Sub
End If
End If

Setel xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Kemudian
'Simpan sebagai file PDF
xSht.ExportAsFixedFormat Jenis:=xlTypePDF, Nama File:=xFolder, Kualitas:=xlQualityStandard

'Buat email Outlook
Setel xOutlookObj = CreateObject("Outlook.Application")
Setel xEmailObj = xOutlookObj.CreateItem(0)
Dengan xEmailObj
.Tampilan
.Untuk = ""
.CC = ""
.Subjek = xSht.Nama + ".pdf"
.Lampiran.Tambahkan xFolder
Jika DisplayEmail = Salah Kemudian
'.Kirim
End If
Berakhir dengan
Lain
MsgBox "Lembar kerja yang aktif tidak boleh kosong"
Keluar dari Sub
End If
End Sub
Komentar ini diminimalkan oleh moderator di situs
Terima kasih untuk itu, itu bagus, tetapi saya ingin lembar diberi nama sesuai sel A1 pada lembar 1. tempat untuk menyimpan sesuai A1 pada lembar 2 misalnya C:\Users\peete\Dropbox\Screenshots, dan kirim email ke alamat email pada lembar A3 2 yang sudah saya kerjakan.
Komentar ini diminimalkan oleh moderator di situs
Terima kasih untuk itu, itu bagus, tetapi saya ingin lembar diberi nama sesuai sel A1 pada lembar 1. tempat untuk menyimpan sesuai A1 pada lembar 2 misalnya C:\Users\peete\Dropbox\Screenshots, tetapi dapat berubah kapan menggunakan file, dan email kirim ke alamat email pada lembar A3 2 yang sudah saya kerjakan.
Komentar ini diminimalkan oleh moderator di situs
Hi kristal , kode yang sangat baik terima kasih telah berbagi. Apakah ada cara untuk memilih beberapa lembar (dari buku kerja yang sama) untuk menyimpan masing-masing sebagai PDF independen dan kemudian mengirim semuanya terlampir dalam satu email?
Komentar ini diminimalkan oleh moderator di situs
Hai, Kode VBA di bawah ini dapat membantu Anda, silakan coba. Di baris kedua belas kode, harap ganti nama sheet dengan nama sheet yang sebenarnya dalam kasus Anda.
Sub Simpan sebagaipdfandsend1()
Redupkan xSht Sebagai Lembar Kerja
Redupkan xFileDlg Sebagai FileDialog
Redupkan xFolder Sebagai String
Redup xYaatauTidak, I, xNum As Integer
Redupkan xOutlookObj Sebagai Objek
Redupkan xEmailObj Sebagai Objek
Redupkan xUsedRng Sebagai Rentang
Redupkan xArrShetts Sebagai Varian
Redupkan xPDFNameAddress Sebagai String
Redupkan xStr Sebagai String
xArrShetts = Larik("uji", "Lembar1", "Lembar2") 'Masukkan nama lembar yang akan Anda kirim sebagai file pdf yang diapit dengan tanda kutip dan pisahkan dengan koma. Pastikan tidak ada karakter khusus seperti \/:"*<>| pada nama file.

Untuk I = 0 Ke UBound(xArrShetts)
On Error Resume Next
Setel xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))
Jika xSht.Name <> xArrShetts(I) Maka
MsgBox "Lembar kerja tidak ditemukan, keluar dari operasi:" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
Keluar dari Sub
End If
Next


Setel xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
Jika xFileDlg.Show = Benar Maka
xFolder = xFileDlg.SelectedItems(1)
Lain
MsgBox "Anda harus menentukan folder untuk menyimpan PDF." & vbCrLf & vbCrLf & "Tekan OK untuk keluar dari makro ini.", vbCritical, "Harus Tentukan Folder Tujuan"
Keluar dari Sub
End If
'Periksa apakah file sudah ada
xYesorNo = MsgBox("Jika ada file dengan nama yang sama di folder tujuan, sufiks nomor akan ditambahkan ke nama file secara otomatis untuk membedakan duplikat" & vbCrLf & vbCrLf & "Klik Ya untuk melanjutkan, klik Tidak untuk membatalkan", _
vbYesNo + vbQuestion, "File Ada")
Jika xYesorNo <> vbYes Kemudian Keluar Sub
Untuk I = 0 Ke UBound(xArrShetts)
Setel xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
xNum = 1
Sementara Tidak (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xJumlah = xJumlah + 1
Pergi ke
Setel xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Kemudian
xSht.ExportAsFixedFormat Jenis:=xlTypePDF, Nama File:=xStr, Kualitas:=xlQualityStandard
Lain

End If
xArrShetts(I) = xStr
Next

'Buat email Outlook
Setel xOutlookObj = CreateObject("Outlook.Application")
Setel xEmailObj = xOutlookObj.CreateItem(0)
Dengan xEmailObj
.Tampilan
.Untuk = ""
.CC = ""
.Subjek = "????"
Untuk I = 0 Ke UBound(xArrShetts)
.Lampiran.Tambahkan xArrShetts(I)
Next
Jika DisplayEmail = Salah Kemudian
'.Kirim
End If
Berakhir dengan
End Sub
Komentar ini diminimalkan oleh moderator di situs
Hai, Satu-satunya perubahan yang saya perjuangkan adalah membuat email terpisah untuk setiap dokumen pdf yang dibuat.
Komentar ini diminimalkan oleh moderator di situs
Hai,Untuk membuat email terpisah untuk setiap dokumen pdf, Anda dapat secara manual menjalankan VBA yang disediakan di pos di lembar kerja yang berbeda untuk menyelesaikannya.
Komentar ini diminimalkan oleh moderator di situs
Saya memiliki lebih dari 100 lembar kerja di buku kerja, yang kemudian mengharuskan saya menjalankan VBA lebih dari 100 kali, yang memakan waktu.  
Saya telah berhasil membagi buku kerja saya menjadi beberapa lembar dan kemudian saya dapat mengonversi setiap lembar kerja menjadi dokumen PDF individual.
Solusi yang saya cari, adalah mengirim email ke setiap dokumen PDF secara terpisah saat proses di atas sedang berjalan.
Dengan ini VBA yang saya jalankan saat ini:
Sub Simpan sebagaipdfandsend1()
Redupkan xSht Sebagai Lembar Kerja
Redupkan xFileDlg Sebagai FileDialog
Redupkan xFolder Sebagai String
Redup xYaatauTidak, I, xNum As Integer
Redupkan xOutlookObj Sebagai Objek
Redupkan xEmailObj Sebagai Objek
Redupkan xUsedRng Sebagai Rentang
Redupkan xArrShetts Sebagai Varian
Redupkan xPDFNameAddress Sebagai String
Redupkan xStr Sebagai 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") 'Masukkan nama sheet yang akan Anda kirim sebagai file pdf yang diapit dengan tanda kutip dan pisahkan dengan koma. Pastikan tidak ada karakter khusus seperti \/:"*<>| pada nama file.

Untuk I = 0 Ke UBound(xArrShetts)
On Error Resume Next
Setel xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))
Jika xSht.Name <> xArrShetts(I) Maka
MsgBox "Lembar kerja tidak ditemukan, keluar dari operasi:" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
Keluar dari Sub
End If
Next


Setel xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
Jika xFileDlg.Show = Benar Maka
xFolder = xFileDlg.SelectedItems(1)
Lain
MsgBox "Anda harus menentukan folder untuk menyimpan PDF." & vbCrLf & vbCrLf & "Tekan OK untuk keluar dari makro ini.", vbCritical, "Harus Tentukan Folder Tujuan"
Keluar dari Sub
End If
'Periksa apakah file sudah ada
xYesorNo = MsgBox("Jika ada file dengan nama yang sama di folder tujuan, sufiks nomor akan ditambahkan ke nama file secara otomatis untuk membedakan duplikat" & vbCrLf & vbCrLf & "Klik Ya untuk melanjutkan, klik Tidak untuk membatalkan", _
vbYesNo + vbQuestion, "File Ada")
Jika xYesorNo <> vbYes Kemudian Keluar Sub
Untuk I = 0 Ke UBound(xArrShetts)
Setel xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
xNum = 1
Sementara Tidak (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xJumlah = xJumlah + 1
Pergi ke
Setel xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Kemudian
xSht.ExportAsFixedFormat Jenis:=xlTypePDF, Nama File:=xStr, Kualitas:=xlQualityStandard
Lain

End If
xArrShetts(I) = xStr
Next

'Buat email Outlook
Setel xOutlookObj = CreateObject("Outlook.Application")
Setel xEmailObj = xOutlookObj.CreateItem(0)
Dengan xEmailObj
.Tampilan
.Ke = "Ctracklegal@ctrack.com"
.CC = ""
.Subjek = "????"
Untuk I = 0 Ke UBound(xArrShetts)
On Error Resume Next
.Lampiran.Tambahkan xArrShetts(I)
Next
Jika DisplayEmail = Salah Kemudian
.Mengirim
Keluar dari Sub
End If
Berakhir dengan


End Sub
Komentar ini diminimalkan oleh moderator di situs
Hai @kristal
Ini luar biasa - hal utama yang saya perjuangkan adalah nama file - Saya ingin nama file ditarik dari sel di lembar kerja daripada menggunakan nama tab. Saya sudah mengedit kode untuk menyimpan secara otomatis ke folder tertentu tetapi saya kesulitan dengan nama file.
Adakah bantuan yang bisa Anda tawarkan?
Komentar ini diminimalkan oleh moderator di situs
Hai Tori,Jika Anda ingin memberi nama file PDF dengan nilai sel tertentu, silakan coba kode berikut. Setelah menjalankan kode dan memilih folder untuk menyimpan file, kotak dialog lain akan muncul, silakan pilih sel yang akan Anda gunakan nilai sebagai nama file PDF, lalu klik OK untuk menyelesaikan.
Sub Simpan sebagaipdfandsend2()
'Diperbaharui oleh Extendoffice 20210521
Redupkan xSht Sebagai Lembar Kerja
Redupkan xFileDlg Sebagai FileDialog
Redupkan xFolder Sebagai String
Redupkan xYesorNo As Integer
Redupkan xOutlookObj Sebagai Objek
Redupkan xEmailObj Sebagai Objek
Redupkan xUsedRng, xRgInser Sebagai Rentang
Redupkan xB Sebagai Boolean
Setel xSht = ActiveSheet
Setel xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Jika xFileDlg.Show = Benar Maka
xFolder = xFileDlg.SelectedItems(1)
Lain
MsgBox "Anda harus menentukan folder untuk menyimpan PDF." & vbCrLf & vbCrLf & "Tekan OK untuk keluar dari makro ini.", vbCritical, "Harus Tentukan Folder Tujuan"
Keluar dari Sub
End If
xB = Benar
On Error Resume Next
Sedangkan xB
Setel xRgInser = Tidak Ada
Set xRgInser = Application.InputBox("Pilih sel yang akan Anda gunakan nilainya untuk menamai file PDF:", "Kutools for Excel", , , , , , 8)
Jika xRgInser Bukan Apa-apa Maka
MsgBox " Tidak ada sel yang dipilih, keluar dari operasi!", vbInformation, "Kutools for Excel"
Keluar dari Sub
End If
Jika xRgInser.Text = "" Maka
MsgBox " Sel yang dipilih kosong, silakan pilih kembali!", vbInformation, "Kutools for Excel"
Lain
xB = Salah
End If
Pergi ke

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

'Periksa apakah file sudah ada
Jika Len(Dir(xFolder)) > 0 Maka
xYesorNo = MsgBox(xFolder & " sudah ada." & vbCrLf & vbCrLf & "Apakah Anda ingin menimpanya?", _
vbYesNo + vbQuestion, "File Ada")
On Error Resume Next
Jika xYesorNo = vbYa Maka
Bunuh xFolder
Lain
MsgBox "jika Anda tidak menimpa PDF yang ada, saya tidak dapat melanjutkan." _
& vbCrLf & vbCrLf & "Tekan OK untuk keluar dari makro ini.", vbCritical, "Keluar dari Makro"
Keluar dari Sub
End If
Jika Err.Number <> 0 Maka
MsgBox "Tidak dapat menghapus file yang ada. Pastikan file tidak terbuka atau tidak dilindungi penulisan." _
& vbCrLf & vbCrLf & "Tekan OK untuk keluar dari makro ini.", vbCritical, "Tidak Dapat Menghapus File"
Keluar dari Sub
End If
End If

Setel xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Kemudian
'Simpan sebagai file PDF
xSht.ExportAsFixedFormat Jenis:=xlTypePDF, Nama File:=xFolder, Kualitas:=xlQualityStandard

'Buat email Outlook
Setel xOutlookObj = CreateObject("Outlook.Application")
Setel xEmailObj = xOutlookObj.CreateItem(0)
Dengan xEmailObj
.Tampilan
.Untuk = ""
.CC = ""
.Subjek = xSht.Nama + ".pdf"
.Lampiran.Tambahkan xFolder
Jika DisplayEmail = Salah Kemudian
'.Kirim
End If
Berakhir dengan
Lain
MsgBox "Lembar kerja yang aktif tidak boleh kosong"
Keluar dari Sub
End If
End Sub
Komentar ini diminimalkan oleh moderator di situs
Hai, saya membutuhkan sesuatu yang serupa jadi inilah yang saya dapatkan. Ini mengambil tanggal saat ini dan membuat folder baru dengan nama tanggal di lokasi tertentu. Ini menempatkan pdf di dalam lokasi baru itu, lalu melampirkan pdf ke email baru. Berfungsi sebagai suguhan. Saya hanya seorang pemula jadi mohon maaf jika terlihat berantakan. :D
Sub PDFTOEMAIL()
Redupkan xSht Sebagai Lembar Kerja
Redupkan xFileDlg Sebagai FileDialog
Redupkan xFolder Sebagai String
Redupkan xYesorNo As Integer
Redupkan xOutlookObj Sebagai Objek
Redupkan xEmailObj Sebagai Objek
Redupkan xUsedRng Sebagai Rentang
Redupkan xPath Sebagai String
Redupkan xOutMsg Sebagai String
Redupkan sFolderName As String, sFolder As String
Redupkan sFolderPath Sebagai String

Setel xSht = ActiveSheet
xFileDate = Format(Sekarang, "dd-mm-yyyy")
sFolder = "C:" 'di sinilah Anda memiliki folder utama
sFolderName = "Akhir minggu" + Format(Sekarang, "dd-mm-yyyy") 'folder yang akan dibuat di folder utama dengan nama Akhir minggu dan tanggal saat ini
sFolderPath = "C:" & sFolderName 'folder utama lagi untuk membuat path baru termasuk folder baru
Setel oFSO = CreateObject("Scripting.FileSystemObject")
Jika oFSO.FolderExists(sFolderPath) Kemudian
MsgBox "Folder sudah ada !" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
Lain
MkDir sFolderPath
MsgBox "Folder baru telah dibuat !" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
End If
xPath = sFolderPath
xFolder = xPath + "\" + xSht.Name + "_" + xFileDate + ".pdf"
Jika Len(Dir(xFolder)) > 0 Maka
xYesorNo = MsgBox(xFolder & " sudah ada." & vbCrLf & vbCrLf & "Apakah Anda ingin menimpanya?", _
vbYesNo + vbQuestion, "File Ada")
On Error Resume Next
Jika xYesorNo = vbYa Maka
Bunuh xFolder
Lain
MsgBox "jika Anda tidak menimpa PDF yang ada, saya tidak dapat melanjutkan." _
& vbCrLf & vbCrLf & "Tekan OK untuk keluar dari makro ini.", vbCritical, "Keluar dari Makro"
Keluar dari Sub
End If
Jika Err.Number <> 0 Maka
MsgBox "Tidak dapat menghapus file yang ada. Pastikan file tidak terbuka atau tidak dilindungi penulisan." _
& vbCrLf & vbCrLf & "Tekan OK untuk keluar dari makro ini.", vbCritical, "Tidak Dapat Menghapus File"
Keluar dari Sub
End If
End If

Setel xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Kemudian
xSht.ExportAsFixedFormat Jenis:=xlTypePDF, Nama File:=xFolder, Kualitas:=xlQualityStandard
Setel xOutlookObj = CreateObject("Outlook.Application")
Setel xEmailObj = xOutlookObj.CreateItem(0)
xOutMsg = " Silakan temukan terlampir Email dan lampiran ini telah dibuat secara otomatis "
'menambahkan catatan bahwa email dibuat secara otomatis

Dengan xEmailObj
.Tampilan
.To = "" 'tambahkan email Anda sendiri
.CC = ""
Subjek = xSht.Name + " PDF untuk akhir minggu " + xFileDate + " - Lokasi " ' subjek termasuk nama sheet, pdf, tanggal dan lokasi, ini dapat diedit sesuai kebutuhan
.Lampiran.Tambahkan xFolder
.HTMLBody = xOutMsg & .HTMLBody
Jika DisplayEmail = Salah Kemudian
'.Kirim <--- Di sini jika Anda menghapus tanda kutip email akan terkirim secara otomatis, jadi harap berhati-hati
End If
Berakhir dengan
Lain
MsgBox "Lembar kerja yang aktif tidak boleh kosong"
Keluar dari Sub
End If
End Sub
Komentar ini diminimalkan oleh moderator di situs
Bagaimana cara mengedit kode ini untuk hanya menyimpan sel ("a1:r99") untuk disimpan sebagai PDF. Saya memiliki barang tambahan di sisi yang tidak saya inginkan dalam dokumen PDF saya.
Sub Simpan sebagaipdfandsend()
'Diperbaharui oleh Extendoffice 20210209
Redupkan xSht Sebagai Lembar Kerja
Redupkan xFileDlg Sebagai FileDialog
Redupkan xFolder Sebagai String
Redupkan xYesorNo As Integer
Redupkan xOutlookObj Sebagai Objek
Redupkan xEmailObj Sebagai Objek
Redupkan xUsedRng Sebagai Rentang
Redupkan xStrName Sebagai String
Redup xV Sebagai Varian

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

Jika xFileDlg.Show = Benar Maka
xFolder = xFileDlg.SelectedItems(1)
Lain
MsgBox "Anda harus menentukan folder untuk menyimpan PDF." & vbCrLf & vbCrLf & "Tekan OK untuk keluar dari makro ini.", vbCritical, "Harus Tentukan Folder Tujuan"
Keluar dari Sub
End If
xStrName = ""
xV = Application.InputBox("Silakan masukkan nama file:", "Kutools for Excel", , , , , , 2)
Jika xV = Salah Maka
Keluar dari Sub
End If
xStrNama = xV
Jika xStrName = "" Maka
MsgBox ("Tidak ada nama file yang dimasukkan, proses keluar!")
Keluar dari Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
'Periksa apakah file sudah ada
Jika Len(Dir(xFolder)) > 0 Maka
xYesorNo = MsgBox(xFolder & " sudah ada." & vbCrLf & vbCrLf & "Apakah Anda ingin menimpanya?", _
vbYesNo + vbQuestion, "File Ada")
On Error Resume Next
Jika xYesorNo = vbYa Maka
Bunuh xFolder
Lain
MsgBox "jika Anda tidak menimpa PDF yang ada, saya tidak dapat melanjutkan." _
& vbCrLf & vbCrLf & "Tekan OK untuk keluar dari makro ini.", vbCritical, "Keluar dari Makro"
Keluar dari Sub
End If
Jika Err.Number <> 0 Maka
MsgBox "Tidak dapat menghapus file yang ada. Pastikan file tidak terbuka atau tidak dilindungi penulisan." _
& vbCrLf & vbCrLf & "Tekan OK untuk keluar dari makro ini.", vbCritical, "Tidak Dapat Menghapus File"
Keluar dari Sub
End If
End If

Setel xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Kemudian
'Simpan sebagai file PDF
xSht.ExportAsFixedFormat Jenis:=xlTypePDF, Nama File:=xFolder, Kualitas:=xlQualityStandard

'Buat email Outlook
Setel xOutlookObj = CreateObject("Outlook.Application")
Setel xEmailObj = xOutlookObj.CreateItem(0)
Dengan xEmailObj
.Tampilan
.Untuk = ""
.CC = ""
.Subjek = xSht.Nama + ".pdf"
.Lampiran.Tambahkan xFolder
Jika DisplayEmail = Salah Kemudian
'.Kirim
End If
Berakhir dengan
Lain
MsgBox "Lembar kerja yang aktif tidak boleh kosong"
Keluar dari Sub
End If
End Sub
Komentar ini diminimalkan oleh moderator di situs
Halo, saya baru saja mencoba kode ini di salah satu lembar kerja saya dan saya telah mengatur area cetak sehingga hal-hal tambahan di bagian bawah tidak muncul di pdf. Cobalah!
Komentar ini diminimalkan oleh moderator di situs
Hi
Terima kasih banyak untuk Kodenya tetapi apakah mungkin untuk menyimpan PDF secara otomatis ke lokasi yang sama dengan file Excel aktif dan dengan nama file yang sama dengan file Excel aktif?
Banyak terima kasih.
batang
Belum ada komentar yang diposting di sini
Muat Lebih
Tinggalkan komentar anda
Posting sebagai Tamu
×
Beri peringkat pos ini:
0   Karakter
Lokasi yang Disarankan