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

Bagaimana cara mengirim email jika sel tertentu diubah di Excel?

Artikel ini berbicara tentang mengirim email melalui Outlook saat sel dalam rentang tertentu dimodifikasi di Excel.

Kirim email jika sel dalam rentang tertentu dimodifikasi dengan kode VBA


Kirim email jika sel dalam rentang tertentu dimodifikasi dengan kode VBA

Jika Anda perlu membuat email baru secara otomatis dengan buku kerja aktif yang dilampirkan saat sel dalam rentang A2:E11 dimodifikasi di lembar kerja tertentu, kode VBA berikut dapat membantu Anda.

1. Di lembar kerja yang Anda perlukan untuk mengirim email berdasarkan sel yang dimodifikasi dalam kisaran tertentu, klik kanan tab lembar dan kemudian klik Lihat kode dari menu konteks. Lihat tangkapan layar:

2. Dalam bermunculan Microsoft Visual Basic untuk Aplikasi jendela, silakan salin dan tempel kode VBA di bawah ini ke jendela Kode.

Kode VBA: Kirim email jika sel dalam kisaran tertentu diubah di Excel

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2017/9/12
    Dim xRgSel As Range
    Dim xOutApp As Object
    Dim xMailItem As Object
    Dim xMailBody As String
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set xRg = Range("A2:E11")
    Set xRgSel = Intersect(Target, xRg)
    ActiveWorkbook.Save
    If Not xRgSel Is Nothing Then
        Set xOutApp = CreateObject("Outlook.Application")
        Set xMailItem = xOutApp.CreateItem(0)
        xMailBody = "Cell(s) " & xRgSel.Address(False, False) & _
            " in the worksheet '" & Me.Name & "' were modified on " & _
            Format$(Now, "mm/dd/yyyy") & " at " & Format$(Now, "hh:mm:ss") & _
            " by " & Environ$("username") & "."

        With xMailItem
            .To = "Email Address"
            .Subject = "Worksheet modified in " & ThisWorkbook.FullName
            .Body = xMailBody
            .Attachments.Add (ThisWorkbook.FullName)
            .Display
        End With
        Set xRgSel = Nothing
        Set xOutApp = Nothing
        Set xMailItem = Nothing
    End If
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Catatan:

1). Di dalam kode, A2: E11 adalah rentang yang akan Anda gunakan untuk mengirim email.
2). Harap ubah badan email sesuai kebutuhan Anda xMailBody baris dalam kode.
3). Ganti Alamat email dengan alamat email penerima sejalan .To = "Alamat Email".
4). Ubah subjek email sesuai .Subject = "Lembar kerja diubah dalam" & Buku Kerja Ini.FullName.

3. tekan lain + Q tombol secara bersamaan untuk menutup Microsoft Visual Basic untuk Aplikasi jendela.

Mulai sekarang, sel apa pun dalam rentang A2: E11 diubah, email baru akan dibuat dengan lampiran buku kerja yang diperbarui. Dan semua bidang yang ditentukan seperti subjek, penerima, dan badan email akan dicantumkan di email. Silakan kirim email.

Note: Kode VBA hanya berfungsi jika Anda menggunakan Outlook sebagai program email Anda.


Artikel terkait:


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-2021 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.
  • Meningkatkan produktivitas Anda sebesar 50%, dan mengurangi ratusan klik mouse untuk Anda setiap hari!
officetab bawah
Urutkan komentar berdasarkan
komentar (37)
Belum ada peringkat. Jadilah yang pertama memberi peringkat!
Komentar ini diminimalkan oleh moderator di situs
Saya terjebak di bawah kode VB. Saya mencoba untuk mendapatkan pemberitahuan email kepada pengguna di mana data telah diubah. Email berfungsi tetapi ketika saya membuat perubahan apa pun, email dimulai sekaligus tetapi saya ingin email ketika lembar excel disimpan dan ditutup setelah membuat semua perubahan ke semua pengguna yang terpengaruh. Juga ini harus berfungsi untuk semua lembar di seluruh buku kerja excel.

Tolong bantu...

Sub Workbook_BeforeSave Pribadi (ByVal SaveAsUI Sebagai Boolean, Batalkan Sebagai Boolean)

'****Deklarasi objek dan variabel******

Redupkan xRgSel As Range Redupkan xOutApp Sebagai Object Dim xMailItem As Object Dim xMailBody As String Redupkan mailTo As String

On Error Resume Next

Sheets("TargetSheet").Range("TargetRange").Pilih

Application.ScreenUpdating = Salah Aplikasi.DisplayAlerts = Salah

'Atur xRg = Rentang("A" & Baris.Jumlah).End(xlUp).Baris

Tetapkan xRg = Range("A2:DA1000")
Tetapkan xRgSel = Intersect(Target, xRg)


ActiveWorkbook.Simpan
'********* Pembukaan Aplikasi Outlook************

Jika Tidak xRgSel Bukan Apa-apa Maka

Setel xOutApp = CreateObject("Outlook.Application")
Setel xMailItem = xOutApp.CreateItem(0)

xMailBody = "Sel" & xRgSel.Alamat(Salah, Salah) & _
" di lembar kerja '" & Saya.Nama & "' telah diubah pada " & _
Format$(Sekarang, "mm/hh/tttt") & " pada " & Format$(Sekarang, "hh:mm:dd") & _
" oleh " & Environ$("nama pengguna") & "."
'************Menemukan Daftar Penerima************

If Cells(xRgSel.Row, "A").Value = "Pankaj" Maka

mailTo = "pank12***@gmail.com"

End If

If Cells(xRgSel.Row, "A").Value = "Nitin" Maka

mailTo = "pank****@gmail.com"

End If

If Cells(xRgSel.Row, "A").Value = "Chandan" Maka

mailTo = "pakxro**@gmail.com"

End If
'*************** Penulisan email************

Dengan xMailItem

.Kepada = suratKepada
.Subject = "Lembar kerja diubah dalam" & Buku Kerja Ini.FullName
.Body = xMailBody
'.Attachments.Add (Buku Kerja Ini.Nama Lengkap)
.Tampilan

Berakhir dengan

Tetapkan xRgSel = Tidak Ada
Setel xOutApp = Tidak Ada
Setel xMailItem = Tidak Ada

End If

Application.DisplayAlerts = Benar
Application.ScreenUpdating = Benar
End Sub
Komentar ini diminimalkan oleh moderator di situs
Pankaj Shukla yang terhormat,
Posting pertanyaan Excel Anda ke forum kami: https://www.extendoffice.com/forum.html untuk mendapatkan lebih banyak dukungan tentang Excel dari profesional Excel kami.
Komentar ini diminimalkan oleh moderator di situs
Saya dapat membuat makro, namun saya mengalami masalah. Saya ingin mengirim email secara otomatis ketika sel mencapai ambang tertentu. Sel adalah rumus. Ketika jumlah perhitungan berjalan di bawah ambang batas tersebut, itu tidak melakukan apa-apa; namun, jika saya mengetik langsung ke dalam sel itu akan memproses makro seperti yang direncanakan. Apakah rumus mengacaukan makro?
Komentar ini diminimalkan oleh moderator di situs
Hai Sissy Jones,
Metode dalam artikel ini: Bagaimana cara mengirim email secara otomatis berdasarkan nilai sel di Excel?
https://www.extendoffice.com/documents/excel/4656-excel-send-email-based-on-cell-value.html dapat membantu Anda memecahkan masalah.
Komentar ini diminimalkan oleh moderator di situs
Admin yang terhormat,


Saya membutuhkan bantuan Anda,



Saya memiliki excel untuk memantau pekerjaan sehari-hari yang dilakukan oleh pekerja kami dari lapangan, jadi apakah ini mungkin untuk memicu email dari lembar excel jika orang itu gagal memperbarui data di lembar excel itu pada waktu tertentu.
Komentar ini diminimalkan oleh moderator di situs
Hai,
Tidak dapat membantu dengan ini.
Komentar ini diminimalkan oleh moderator di situs
Jika saya ingin mengirim nilai sel alih-alih alamat..lalu apa yang harus saya ubah dalam kode?
Komentar ini diminimalkan oleh moderator di situs
Hai,
Anda dapat mencoba kode VBA di bawah ini.

Sub Lembar Kerja Pribadi_Rubah (Rentang Target As ByVal)
Redupkan xRgSel Sebagai Rentang
Redupkan xOutApp Sebagai Objek
Redupkan xMailItem Sebagai Objek
Redupkan xMailBody Sebagai String
On Error Resume Next
Application.ScreenUpdating = Salah
Application.DisplayAlerts = Salah
Tetapkan xRg = Range("A2:E11")
Tetapkan xRgSel = Intersect(Target, xRg)
ActiveWorkbook.Simpan
Jika Tidak xRgSel Bukan Apa-apa Maka
Setel xOutApp = CreateObject("Outlook.Application")
Setel xMailItem = xOutApp.CreateItem(0)
xMailBody = "Sel" & xRgSel.Alamat(Salah, Salah) & _
xRgSel.Nilai & _
" di lembar kerja '" & Saya.Nama & "' telah diubah pada " & _
Format$(Sekarang, "mm/hh/tttt") & " pada " & Format$(Sekarang, "hh:mm:dd") & _
" oleh " & Environ$("nama pengguna") & "."

Dengan xMailItem
.To = "Alamat Email"
.Subject = "Lembar kerja diubah dalam" & Buku Kerja Ini.FullName
.Body = xMailBody
.Attachments.Add (Buku Kerja Ini.Nama Lengkap)
.Tampilan
Berakhir dengan
Tetapkan xRgSel = Tidak Ada
Setel xOutApp = Tidak Ada
Setel xMailItem = Tidak Ada
End If
Application.DisplayAlerts = Benar
Application.ScreenUpdating = Benar
End Sub
Komentar ini diminimalkan oleh moderator di situs
Bagaimana jika kita hanya ingin komentar yang diperbarui di sel itu dan bukan seluruh nilai sel? Seharusnya hanya menampilkan komentar terbaru yang ditambahkan di sel
Komentar ini diminimalkan oleh moderator di situs
Apakah Anda mengetahui hal ini?
Komentar ini diminimalkan oleh moderator di situs
Informasi yang bagus.
Pertanyaan mengenai informasi yang dapat ditambahkan ke email.
Menggunakan contoh Anda di atas ....

Jika Anda memiliki nilai di F4, bagaimana Anda memasukkan Nilai F4 di email yang dihasilkan saat D4 dimodifikasi??
Komentar ini diminimalkan oleh moderator di situs
jika saya harus mengirim seluruh baris itu?
Komentar ini diminimalkan oleh moderator di situs
Saya telah mencoba kode VBA di atas: Kirim email jika sel dalam rentang tertentu dimodifikasi di Excel. VBA ini berfungsi untuk saya kecuali mengirim email. Ketika data diubah dalam rentang yang diberikan, email secara otomatis dibuat dengan detail sel yang dimodifikasi. Namun, email tidak secara otomatis terkirim ke penerima dan pengguna harus mengklik tombol kirim di email. Apa yang saya cari di sini adalah, email harus dikirim ke penerima secara otomatis saat dibuat. Tolong bantu saya untuk memberikan kode untuk ini. Terimakasih banyak
Komentar ini diminimalkan oleh moderator di situs
Halo Jimmy Joseph,
Silakan ganti baris ".Display" dengan ".Send". Semoga saya bisa membantu. Terima kasih telah berkomentar.
Komentar ini diminimalkan oleh moderator di situs
hai; apakah ada cara untuk mengubah teks yang ditampilkan menggunakan informasi dari sel lain (dari baris pertama dan kolom pertama)? misalnya jika saya mengganti sel K15, saya ingin memasukkan info pesan di sel A15 dan K1? apa yang harus saya ubah dalam kode? terima kasih banyak
Komentar ini diminimalkan oleh moderator di situs
hai Laona. apakah kamu tahu bagaimana melakukan ini?
Komentar ini diminimalkan oleh moderator di situs
Halo. Bagaimana cara mengubah kode sehingga email dikirim ke alamat email lain jika rentang sel lain diedit?
Komentar ini diminimalkan oleh moderator di situs
Adakah bantuan untuk permintaan ini? Saya mengalami masalah yang sama. Saya ingin menambahkan beberapa alamat email per baris, tetapi ketika saya mengubah satu baris, seluruh lembar kerja berubah. Bagaimana saya bisa membatasi perubahan hanya pada satu baris?
Komentar ini diminimalkan oleh moderator di situs
Edit baris:
1). Dalam kode, A2:E11 adalah rentang yang akan Anda gunakan untuk mengirim email.
serta
3). Ganti Alamat Email dengan alamat email penerima pada baris .To = "Alamat Email".

Bekerja dengan baik.
Komentar ini diminimalkan oleh moderator di situs
Bisakah Anda menjelaskan ini lebih lanjut. Bagaimana Anda mengulangi kode untuk mengirim ke email yang berbeda berdasarkan rentang lain yang sedang dimodifikasi. Saya telah mencoba menyalin dan menempelkan kode di bawah ini dan mengubahnya sesuai komentar Anda, tetapi masih hanya rentang pertama yang tampaknya menjalankan perintah dan menulis email.
Komentar ini diminimalkan oleh moderator di situs
Apakah ada yang punya jawaban untuk ini?
Komentar ini diminimalkan oleh moderator di situs
Halo, saya mencoba mengirim email di lembar saya menggunakan satu nilai yang diubah pada lembar. Jika pada kolom H statusnya akan berubah menjadi ="4" maka Order ID di sebelah kiri harus dikirimkan ke satu pengguna. Lembar bekerja secara dinamis jadi saya memiliki Rentang dari D9:D140 di mana id pesanan disimpan dan perubahan status dibuat dalam rentang yang sama pada H9:H140. Bagaimana saya bisa mencapai tujuan untuk melakukannya dan mengirim ID Pesanan ke pelanggan saya ketika status telah diubah menjadi ="4" ?
Komentar ini diminimalkan oleh moderator di situs
Apakah mungkin untuk menampilkan sel referensi yang berbeda di xMailBody di kolom yang sama alih-alih alamat sel yang dimodifikasi??
Komentar ini diminimalkan oleh moderator di situs
Hai Sam,Apakah maksud Anda memilih sel referensi secara acak di kolom yang sama dari alamat sel yang dimodifikasi?Atau secara manual mengetikkan sel referensi di baris kode xMailBody? Sangat mudah untuk mengetikkan sel referensi secara manual dalam kode, cukup lampirkan sel referensi dengan tanda kutip ganda seperti yang ditunjukkan di bawah ini: xMailBody = "Cell(s)" & "D3" & "," & "D8" & _

Komentar ini diminimalkan oleh moderator di situs
Apakah mungkin untuk mengubah ini sehingga hanya menampilkan email jika sel dalam rentang telah diubah untuk mengatakan "Ya". Ingin itu tidak melakukan apa pun jika itu adalah nilai lain.
Komentar ini diminimalkan oleh moderator di situs
Terima kasih atas kodenya, kode ini berfungsi ketika saya memasukkan nilainya dan tekan enter. Tetapi dalam kasus saya, sel terisi secara otomatis dengan rumus, dan ketika nilainya tercapai, email tidak terbuka sehingga kode tidak berfungsi dalam kasus ini. Terima kasih sebelumnya!
Komentar ini diminimalkan oleh moderator di situs
Hai hakana,
Kode VBA berikut dapat membantu Anda memecahkan masalah. Ayo cobalah. Terima kasih atas tanggapan Anda.

Sub Worksheet_Change Pribadi (Target ByVal Sebagai Rentang)
'Diperbaharui oleh Extendoffice 2022 / 04 / 15
Redupkan xRgSel Sebagai Rentang
Redupkan xOutApp Sebagai Objek
Redupkan xMailItem Sebagai Objek
Redupkan xMailBody Sebagai String
Redupkan xBoolean Sebagai Boolean
Redupkan xItsRG Sebagai Rentang
Redupkan xDDs Sebagai Rentang
Redupkan xDs Sebagai Rentang
On Error Resume Next
Application.ScreenUpdating = Salah
Application.DisplayAlerts = Salah
xBoolean = Salah
Tetapkan xRg = Rentang("E2:E13")

Tetapkan xItsRG = Intersect(Target, xRg)
Tetapkan xDDs = Intersect(Target.DirectDependents, xRg)
Tetapkan xDs = Intersect(Target.Dependents, xRg)
Jika Tidak (xItsRG Bukan Apa-apa) Maka
Tetapkan xRgSel = xItsRG
xBoolean = Benar
LainJika Tidak (xDDs Bukan Apa-apa) Lalu
Tetapkan xRgSel = xDDs
xBoolean = Benar
LainJika Tidak (xDs Bukan Apa-apa) Lalu
Tetapkan xRgSel = xDs
xBoolean = Benar
End If


ActiveWorkbook.Simpan
Jika xBoolean Maka
Debug.Print xRgSel.Address


Setel xOutApp = CreateObject("Outlook.Application")
Setel xMailItem = xOutApp.CreateItem(0)
xMailBody = "Sel" & xRgSel.Alamat(Salah, Salah) & _
" di lembar kerja '" & Saya.Nama & "' telah diubah pada " & _
Format$(Sekarang, "mm/hh/tttt") & " pada " & Format$(Sekarang, "hh:mm:dd") & _
" oleh " & Environ$("nama pengguna") & "."

Dengan xMailItem
.To = "Alamat Email"
.Subject = "Lembar kerja diubah dalam" & Buku Kerja Ini.FullName
.Body = xMailBody
.Attachments.Add (Buku Kerja Ini.Nama Lengkap)
.Tampilan
Berakhir dengan
Tetapkan xRgSel = Tidak Ada
Setel xOutApp = Tidak Ada
Setel xMailItem = Tidak Ada
End If
Application.DisplayAlerts = Benar
Application.ScreenUpdating = Benar
End Sub
Komentar ini diminimalkan oleh moderator di situs
Halo, Saya telah membuat kode serupa tetapi saya ingin *** suatu kondisi di mana jika nilai sel dihapus, itu tidak akan mengirim email saat disimpan/ditutup. Itu hanya akan mengirim email ketika nilai sel telah dimasukkan. Apakah Anda tahu bagaimana melakukan ini? Ini kode saya:

KODE EMAIL OTOMATIS KEPADA SESEORANG KETIKA WORKBOOK EXCEL DIPERBARUI

KODE LEMBAR:

Opsi Eksplisit 'Rentang acara perubahan lembar kerja Excel
Sub Lembar Kerja Pribadi_Rubah (Rentang Target As ByVal)
Jika Tidak Berpotongan(Target, Rentang("C3:D62")) Tidak Ada Apa-apanya
'Target.EntireRow.Interior.ColorIndex = 15
Rentang("XFD1048576").Nilai = 15
End If
Jika Tidak Berpotongan(Target, Rentang("I3:J21")) Tidak Ada Apa-apanya
'Target.EntireRow.Interior.ColorIndex = 15
Rentang("XFD1048576").Nilai = 15
End If
End Sub


KODE BUKU KERJA:

Sub Workbook_BeforeClose Pribadi (Batalkan Sebagai Boolean)
Jika Saya.Disimpan = Salah Maka Saya.Simpan

Redupkan xOutApp Sebagai Objek
Redupkan xMailItem Sebagai Objek
Redupkan xName As String

If Range("XFD1048576").Nilai = 15 Maka
On Error Resume Next
Setel xOutApp = CreateObject("Outlook.Application")
Setel xMailItem = xOutApp.CreateItem(0)
xName = ActiveWorkbook.Nama Lengkap
Dengan xMailItem
.Ke = "email"
.CC = ""
.Subjek = "pesan"
.Body = "pesan!"
.Lampiran.*** xNama
.Tampilan
'.Kirim
Berakhir dengan
End If
Setel xMailItem = Tidak Ada
Setel xOutApp = Tidak Ada



End Sub

Sub Workbook_Open Pribadi ()
Rentang ("XFD1048576"). Hapus
End Sub
Komentar ini diminimalkan oleh moderator di situs
Hi semua,

der Code würde gut für mein Vorhaben passen, aber gibt es die Möglichkeit, dass er eine Email beim speichern schreibt mit allen Zellen die geändert wurden? Jadi wie es jetzt ist,würde er jede geänderte Zelle einzeln senden. Dies ist dann problematisch wenn zB 10 Zellen angepasst werden is 10 E-Mails beeuten würde. Und gibt es die Möglichkeit, die gesamte geänderte Zelle bei mir von A bis Y in einer E-Mail zu senden? Bisher haut der ja die Zellnummer in die E-Mail, wenn aber jemand anders Filtert wird er die nderung nicht mehr finden.
Komentar ini diminimalkan oleh moderator di situs
Hai Esser123,
Kode VBA berikut dapat membantu. Setelah memodifikasi sel dalam rentang yang ditentukan dan menyimpan buku kerja, sebuah email akan muncul untuk mencantumkan semua sel yang dimodifikasi di badan email, dan buku kerja juga akan disisipkan sebagai lampiran di email. Silakan ikuti langkah-langkah berikut:
1. Buka lembar kerja yang berisi sel yang ingin Anda kirimi email, klik kanan tab lembar dan klik Lihat kode dari menu klik kanan. Kemudian salin kode berikut ke dalam jendela sheet(code).
Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220921
Dim xAddress As String
Dim xDRg, xRgSel, xRg As Range

xAddress = "A1:A8"
Set xDRg = Range(xAddress)
Set xRgSel = Intersect(Target, xDRg)
On Error GoTo Err1
If Not xRgSel Is Nothing Then
If ThisWorkbook.gChangeRange = "" Then
ThisWorkbook.gChangeRange = xRgSel.AddressLocal(False, False, xlA1, True, False)
Else
Set xRg = Range(ThisWorkbook.gChangeRange)
Set xRg = Application.Union(xRg, xRgSel)
ThisWorkbook.gChangeRange = xRg.AddressLocal(False, False, xlA1, True, False)
End If
End If
Exit Sub
Err1:
      ThisWorkbook.gChangeRange = xRgSel.AddressLocal(False, False, xlA1, True, False)
End Sub

2. Di editor Visual Basic, klik dua kali Buku Kerja Ini di panel kiri, lalu salin kode VBA berikut ke ThisWorkbook (Kode) jendela.
Option Explicit
Public gChangeRange As String
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
'Updated by Extendoffice 20220921
Dim xRgSel, xRg As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xMailBody As String
'On Error Resume Next
On Error GoTo Err1
Set xRg = Range(gChangeRange)
If Not xRg Is Nothing Then
   Set xOutApp = CreateObject("Outlook.Application")
        Set xMailItem = xOutApp.CreateItem(0)
        xMailBody = "Email Body: " & vbCrLf & "The following cells were modified:" & xRg.Address(False, False)
        With xMailItem
            .To = "Email Address"
            .Subject = "Worksheet modified in " & ThisWorkbook.FullName
            .Body = xMailBody
            .Attachments.Add (ThisWorkbook.FullName)
            .Display
        End With
        Set xRgSel = Nothing
        Set xOutApp = Nothing
        Set xMailItem = Nothing
End If
Err1:
gChangeRange = ""
End Sub
Komentar ini diminimalkan oleh moderator di situs
Saya butuh bantuan untuk memicu email dengan sedikit perubahan. Alih-alih nilai numerik atau memasukkan informasi ke dalam sel secara manual, sel di kolom B akan berubah menjadi 'Y' yang dipicu dari rumus di sel lain di baris itu. Rumus untuk kolom B adalah =IF([@[Quantity in Stock]]>[@[Reorder Level]],,"Y"), menunjukkan bahwa inventory sudah sedikit dan membutuhkan pemesanan ulang. Saya perlu memicu email otomatis ketika nilai sel berubah di kolom B menjadi 'Y', jadi saya diberi tahu secara otomatis melalui email tentang stok rendah. Saya sudah mencoba semua yang dapat saya pikirkan dalam mengubah kode yang sudah disediakan, tetapi sepertinya tidak ada yang berhasil untuk saya ... tolong bantu!
Komentar ini diminimalkan oleh moderator di situs
Hai Kathryn F,
Kode VBA berikut dapat membantu Anda memecahkan masalah. Ayo cobalah. Terima kasih atas komentarmu.
Dim xRg As Range
'Update by Extendoffice 20221019
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("B:B"), Target)
If xRg Is Nothing Then Exit Sub
If Target.Value = "Y" Then
Call Mail_small_Text_Outlook
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2"
On Error Resume Next
With xOutMail
.To = "Email Address"
.CC = ""
.BCC = ""
.Subject = "send by cell value test"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub

Private Sub Worksheet_Calculate()
Dim xTarget As String
Dim xRg As Range
'Set xRg = Application.Range("B:B")
Set xRg = Intersect(Range("B:B"), Selection.EntireRow)
On Error GoTo Err01
If xRg.Value = "Y" Then
Call Mail_small_Text_Outlook
End If
Err01:
End Sub
Komentar ini diminimalkan oleh moderator di situs
Halo dan terima kasih untuk tutorial ini.
J'ai cependant une hardé pour l'application de la plage de recherche.
Dans le code, j'ai demandé vérifier la plage C2:C4.
Tout fonctionne bien si je memodifikasi keunikan C2, C3 atau C4. Cela fonctionne aussi si je modifie C2+C3+C4 ou C2+C3 ou C3+C4 mais cela ne fonctionne pas si j'ai un saut dans la plage. Contoh par, si je modifie C2 dan C4 sans modifier C3.
Est-ce que quelqu'un pourrait m'aider pour m'indiquer où se trouve mon erreur ?
Merci d'avance.

Sub Lembar Kerja Pribadi_Rubah (Rentang Target As ByVal)
'Diperbaharui oleh Extendoffice 20220921
Redupkan xAlamat Sebagai String
Redupkan xDRg, xRgSel, xRg Sebagai Rentang

xAlamat = "C2:C4"
Tetapkan xDRg = Rentang (xAddress)
Tetapkan xRgSel = Intersect(Target, xDRg)
Pada Kesalahan GoTo Err1
Jika Tidak xRgSel Bukan Apa-apa Maka
Jika ThisWorkbook.gChangeRange = "" Maka
ThisWorkbook.gChangeRange = xRgSel.AddressLocal(Salah, Salah, xlA1, Benar, Salah)
Lain
Setel xRg = Rentang (Buku Kerja Ini.gChangeRange)
Tetapkan xRg = Aplikasi.Union(xRg, xRgSel)
ThisWorkbook.gChangeRange = xRg.AddressLocal(Salah, Salah, xlA1, Benar, Salah)
End If
End If
Keluar dari Sub
Err1:
ThisWorkbook.gChangeRange = xRgSel.AddressLocal(Salah, Salah, xlA1, Benar, Salah)
End Sub


-----

Opsi Eksplisit
gChangeRange Publik Sebagai String
Sub Workbook_AfterSave Pribadi (Sukses ByVal Sebagai Boolean)
'Diperbaharui oleh Extendoffice 20220921
Redupkan xRgSel, xRg Sebagai Rentang
Redupkan xOutApp Sebagai Objek
Redupkan xMailItem Sebagai Objek
Redupkan xMailBody Sebagai String
'Pada Kesalahan Lanjutkan Selanjutnya
Pada Kesalahan GoTo Err1
Tetapkan xRg = Rentang (gChangeRange)
Jika Tidak xRg Bukan Apa-apa Maka
Setel xOutApp = CreateObject("Outlook.Application")
Setel xMailItem = xOutApp.CreateItem(0)
xMailBody = "Cher Jean-Marie, " & vbCrLf & vbCrLf & "Dans le fichier : " & ThisWorkbook.Nama Lengkap & vbCrLf & "La plage de cellules a été modifiée :" & xRg.Address(False, False) & vbCrLf & vbCrLf & vbCrLf & "Persahabatan"
Dengan xMailItem
.Ke = "x.xxxxxx@xxxx.fr"
.Subject = "Données modifiées " & ThisWorkbook.Name
.Body = xMailBody
.Attachments.Add (Buku Kerja Ini.Nama Lengkap)
.Tampilan
Berakhir dengan
Tetapkan xRgSel = Tidak Ada
Setel xOutApp = Tidak Ada
Setel xMailItem = Tidak Ada
End If
Err1:
gUbahRentang = ""
End Sub
Komentar ini diminimalkan oleh moderator di situs
Saya ingin mengirim email ke 5 orang. Penggambar apa yang digunakan di antara setiap alamat email?
Komentar ini diminimalkan oleh moderator di situs
Hai Joe,
Silakan gunakan titik koma untuk memisahkan alamat email.
Komentar ini diminimalkan oleh moderator di situs
Ini pertanyaan lain. Jika satu sel berubah, ia mengirim email. jika 3 sel berubah, ia mengirim 3 email. Bagaimana Anda menghentikan ini sehingga hanya mengirim 1 email saat pengeditan selesai?
Komentar ini diminimalkan oleh moderator di situs
Hai Joe,
Misalkan Anda menentukan rentang sebagai "A2:E11" dalam kode. Bagaimana saya bisa memverifikasi kapan seluruh pengeditan selesai?
Belum ada komentar yang diposting di sini
Tinggalkan komentar anda
Posting sebagai Tamu
×
Beri peringkat pos ini:
0   Karakter
Lokasi yang Disarankan

Ikuti kami

Hak Cipta © 2009 - www.extendoffice.com. | Seluruh hak cipta. Dipersembahkan oleh ExtendOffice. | Peta Situs
Microsoft dan logo Office adalah merek dagang atau merek dagang terdaftar dari Microsoft Corporation di Amerika Serikat dan / atau negara lain.
Dilindungi oleh Sectigo SSL