By Tamu pada hari Sabtu, 01 September 2018
Balasan 0
"Like" 0
views 2.6K
Suara 0
Saya menginstal kutools untuk membantu proyek pekerjaan. Saya juga mengelola laporan perusahaan besar yang memiliki makro yang membuat email dari informasi yang dimasukkan. Makro itu telah berhenti bekerja di komputer saya. Ini bekerja pada komputer yang tidak memiliki kutools. Adakah yang pernah mengalami hal seperti ini sebelumnya? Berikut adalah makro yang berfungsi dengan baik di komputer lain:

Sub Mail_Sheet_Outlook_Body()
'Bekerja di Excel 2000-2016
Aplikasi.ReferenceStyle = xlA1
Dim rng Sebagai Rentang
Redupkan OutApp Sebagai Objek
Redupkan OutMail Sebagai Objek
Redupkan xFolder Sebagai String
Redupkan xSht Sebagai Lembar Kerja
Redupkan xSub Sebagai String
Respon Redup Sebagai String
Redupkan Pesan Sebagai String
Gaya Redup Sebagai String
Redupkan Judul Sebagai String

Setel xSht = ActiveSheet
Msg = "Apakah Anda yakin ingin mengirimkan formulir ini melalui email?" ' Tentukan pesan.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Tentukan tombol.
Judul = "Konfirmasi pengiriman email" ' Tentukan judul.
Respon = MsgBox(Pesan, Gaya)

Jika Respon = vbYa Maka
xFolder = Environ("USERPROFILE") + "\Desktop\" + "\Field Audit Form--" + CStr(xSht.Cells(19, "A").Nilai) + "--.pdf"
'xSub = "Audit Bidang untuk toko " + CStr(xSht.Cells(19, "A").Nilai)
Dengan Aplikasi
.EnableEvents = Salah
.ScreenUpdating = Salah
Berakhir dengan

Tetapkan rng = Tidak ada
Setel rng = ActiveSheet.UsedRange
'Anda juga dapat menggunakan nama sheet
'Set rng = Sheets("YourSheet").UsedRange

Atur OutApp = CreateObject("Outlook.Application")
Atur OutMail = OutApp.CreateItem(0)
Redupkan varCellvalue Selamanya




On Error Resume Next
Dengan OutMail
.Untuk = ""
.CC = ""
.BCC = ""
.Subjek = "Ringkasan"
.Lampiran.Tambahkan xFolder
.HTMLBody = Rentang keHTML(rng)
.Tampilkan 'atau gunakan .Tampilan

Berakhir dengan
Pada Kesalahan GoTo 0

Dengan Aplikasi
.EnableEvents = Benar
.ScreenUpdating = Benar
Berakhir dengan

Atur OutMail = Tidak Ada
Atur OutApp = Tidak Ada
End If
End Sub


Rentang FungsitoHTML(rng Sebagai Rentang)
' Bekerja di Office 2000-2016
Redupkan fso Sebagai Obyek
Redupkan Sebagai Objek
Redupkan TempFile Sebagai String
Redupkan TempWB Sebagai Buku Kerja

TempFile = Environ$("temp") & "\" & Format(Sekarang, "dd-mm-yy h-mm-ss") & ".htm"

'Salin rentang dan buat buku kerja baru untuk memasukkan data
rng.Salin
Atur TempWB = Workbooks.Add(1)
Dengan TempWB.Sheets(1)
.Sel (1). Tempel Tempel Khusus:=8
.Cells(1).PasteSpecial xlPasteValues, , Salah, Salah
.Cells(1).PasteSpecial xlPasteFormats, , Salah, Salah
.Sel(1).Pilih
Application.CutCopyMode = Salah
On Error Resume Next
.DrawingObjects.Visible = Benar
.MenggambarObjek.Hapus
Pada Kesalahan GoTo 0
Berakhir dengan

'Publikasikan lembar ke file htm
Dengan TempWB.PublishObjects.Add( _
Tipe Sumber:=xlSourceRange, _
Nama File:=TempFile, _
Sheet:=TempWB.Sheets(1).Nama, _
Sumber:=TempWB.Sheets(1).UsedRange.Address, _
Tipe Html:=xlHtmlStatis)
.Publikasikan (Benar)
Berakhir dengan

'Baca semua data dari file htm ke RangetoHTML
Setel fso = CreateObject ("Scripting.FileSystemObject")
Setel ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.baca semua
ts.Tutup
RangetoHTML = Ganti(RangetoHTML, "align=center x:publishsource=", _
"align=kiri x:publishsource=")

'Tutup TempWB
TempWB.Tutup savechanges:=False

'Hapus file htm yang kami gunakan dalam fungsi ini
Bunuh TempFile
Tetapkan ts = Tidak ada
Tetapkan fso = Tidak ada
Setel TempWB = Tidak Ada

End Function
Lihat Posting Lengkap