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

Excel'de belirli bir hücre değiştirilirse e-posta nasıl gönderilir?

Bu makale, Excel'de belirli bir aralıktaki bir hücre değiştirildiğinde Outlook aracılığıyla bir e-posta göndermekten bahsediyor.

Belirli bir aralıktaki hücre VBA kodu ile değiştirilirse e-posta gönderin


Belirli bir aralıktaki hücre VBA kodu ile değiştirilirse e-posta gönderin


Belirli bir çalışma sayfasında A2:E11 aralığındaki bir hücre değiştirildiğinde etkin çalışma kitabı eklenmiş olarak otomatik olarak yeni bir e-posta oluşturmanız gerekirse, aşağıdaki VBA kodu size yardımcı olabilir.

1. Belirli bir aralıktaki değiştirilmiş hücreye göre e-posta göndermeniz gereken çalışma sayfasında, sayfa sekmesine sağ tıklayın ve ardından Kodu Görüntüle bağlam menüsünden. Ekran görüntüsüne bakın:

2. Açılırken Uygulamalar için Microsoft Visual Basic penceresi, lütfen VBA kodunu kopyalayıp Kod penceresine yapıştırın.

VBA kodu: Belirtilen aralıktaki hücre Excel'de değiştirilirse e-posta gönderin

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

notlar:

1). Kodda, A2: E11 e-postayı temel alarak göndereceğiniz aralıktır.
2). Lütfen ihtiyacınız olan e-posta gövdesini değiştirin xMailBody koddaki satır.
3). Değiştirin Eposta Adresi alıcı e-posta adresi ile aynı hizada .To = "E-posta Adresi".
4). E-posta konusunu satırda değiştirin .Subject = "Çalışma sayfası değiştirildi" & ThisWorkbook.FullName.

3. Tuşuna basın. Ara Toplam + Q kapatmak için aynı anda tuşları Uygulamalar için Microsoft Visual Basic pencere.

Şu andan itibaren, A2: E11 aralığındaki herhangi bir hücre değiştirilir, güncellenmiş çalışma kitabının ekli olduğu yeni bir e-posta oluşturulur. Ve konu, alıcı ve e-posta gövdesi gibi belirtilen tüm alanlar e-postada listelenecektir. Lütfen e-postayı gönderin.

not: VBA kodu, yalnızca Outlook'u e-posta programınız olarak kullanıyorsanız çalışır.


İlgili yazılar:


En İyi Ofis Üretkenliği Araçları

Kutools for Excel Sorunlarınızın Çoğunu Çözer ve Verimliliğinizi% 80 Artırır

  • Yeniden: Hızlıca yerleştirin karmaşık formüller, grafikler ve daha önce kullandığınız her şey; Hücreleri Şifrele şifre ile; Posta Listesi Oluşturun ve e-posta gönder ...
  • Süper Formül Çubuğu (birden çok metin ve formül satırını kolayca düzenleyin); Okuma Düzeni (çok sayıda hücreyi kolayca okuyun ve düzenleyin); Filtrelenmiş Aralığa Yapıştır...
  • Hücreleri / Satırları / Sütunları Birleştirme Veri kaybetmeden; Bölünmüş Hücre İçeriği; Yinelenen Satırları / Sütunları Birleştirme... Yinelenen Hücreleri Önleyin; Aralıkları Karşılaştır...
  • Yinelenen veya Benzersiz'i seçin Satırlar; Boş Satırları Seçin (tüm hücreler boştur); Süper Bul ve Bulanık Bul Birçok Çalışma Kitabında; Rastgele Seçim ...
  • Tam kopya Formül referansını değiştirmeden Birden Çok Hücre; Otomatik Referans Oluştur Birden Çok Sayfaya; Madde İşaretleri Ekle, Onay Kutuları ve daha fazlası ...
  • Metni Çıkar, Metin Ekle, Konuma Göre Kaldır, Alanı Kaldır; Sayfalama Alt Toplamları Oluşturma ve Yazdırma; Hücre İçeriği ve Yorumları Arasında Dönüştür...
  • Süper Filtre (filtre şemalarını kaydedin ve diğer sayfalara uygulayın); Gelişmiş Sıralama ay / hafta / gün, sıklık ve daha fazlasına göre; Özel Filtre kalın, italik ...
  • Çalışma Kitaplarını ve Çalışma Sayfalarını Birleştirin; Tabloları anahtar sütunlara göre birleştirin; Verileri Birden Çok Sayfaya Bölme; Toplu dönüştürme xls, xlsx ve PDF...
  • 300'den fazla güçlü özellik. Office / Excel 2007-2019 ve 365'i destekler. Tüm dilleri destekler. Kuruluşunuzda veya kuruluşunuzda kolay dağıtım. Tam özellikli 30 günlük ücretsiz deneme. 60 günlük para iade garantisi.
kte sekmesi 201905

Office Tab, Office'e Sekmeli Arayüz Getirir ve İşinizi Çok Daha Kolay Hale Getirir

  • Word, Excel, PowerPoint'te sekmeli düzenlemeyi ve okumayı etkinleştirin, Publisher, Access, Visio ve Project.
  • Yeni pencereler yerine aynı pencerenin yeni sekmelerinde birden çok belge açın ve oluşturun.
  • Üretkenliğinizi% 50 artırır ve her gün sizin için yüzlerce fare tıklamasını azaltır!
ofis tabanı
Yorumları sıralama ölçütü
Yorumlar (30)
Henüz derecelendirme yok. İlk değerlendiren siz olun!
Bu yorum sitedeki moderatör tarafından en aza indirildi
VB kodunun altında sıkışıp kaldım. Verilerin değiştirildiği kullanıcıya e-posta bildirimi almaya çalışıyorum. E-posta çalışıyor, ancak herhangi bir değişiklik e-postasını bir kerede başlattığımda, ancak etkilenen tüm kullanıcılara tüm değişiklikleri yaptıktan sonra excel sayfası kaydedildiğinde ve kapatıldığında e-posta istiyorum. Ayrıca bu, tüm excel çalışma kitabındaki sayfalardan herhangi biri için çalışıyor olmalıdır.

Lütfen yardım edin ...

Private Sub Workbook_BeforeSave (Boolean'dan ByVal SaveAsUI, Boole Olarak İptal Et)

'***Nesnelerin ve değişkenlerin bildirilmesi******

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

On Error Resume Next

Sheets("TargetSheet").Range("TargetRange").Seç

Application.ScreenUpdating = Yanlış Application.DisplayAlerts = Yanlış

'Set xRg = Range("A" & Rows.Count).End(xlUp).Satır

xRg = Aralık ("A2:DA1000") olarak ayarla
xRgSel'i ayarla = Kesiştir(Hedef, xRg)


ActiveWorkbook.Save
'**********Outlook Uygulama Açılışı*************

xRgSel Değilse O Zaman Hiçbir Şey Değilse

xOutApp = CreateObject("Outlook.Application") olarak ayarlayın
xMailItem = xOutApp.CreateItem(0) olarak ayarlayın

xMailBody = "Hücre(ler)" & xRgSel.Address(Yanlış, Yanlış) & _
" çalışma sayfasındaki '" & Me.Name & "', " & _ üzerinde değiştirildi
Format$(Şimdi, "aa/gg/yyyy") & " at " & Format$(Şimdi, "ss:dd:ss") & _
" tarafından " & Environ$("kullanıcı adı") & "."
'***********Alıcı Listesi Bulunuyor*************

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

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

Eğer son

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

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

Eğer son

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

mailTo = "pakxro**@gmail.com"

Eğer son
'*************E-posta oluşturma*************

xMailItem ile

.To = mailTo
.Subject = "Çalışma sayfası değiştirildi" & ThisWorkbook.FullName
.Body = xMailBody
'.Attachments.Add (ThisWorkbook.FullName)
.Görüntüle

İle bitmek

xRgSel'i ayarla = Hiçbir şey
xOutApp'ı ayarla = Hiçbir şey
xMailItem'i ayarla = Hiçbir şey

Eğer son

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sevgili Pankaj Shukla,
Excel sorunuzu forumumuza gönderin: https://www.extendoffice.com/forum.html Excel uzmanımızdan Excel hakkında daha fazla destek almak için.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Makroyu oluşturabildim, ancak bir sorunum var. Bir hücre belirli bir eşiğe ulaştığında otomatik olarak bir e-posta göndermek istiyorum. Hücre bir formüldür. Hesap toplamı söz konusu eşiğin altına düştüğünde hiçbir şey yapmaz; ancak, doğrudan hücreye yazarsam makroyu planlandığı gibi işleyecektir. Formül makroyu karıştırıyor mu?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Sissy Jones,
Bu makaledeki yöntem: Excel'deki hücre değerine göre otomatik olarak e-posta nasıl gönderilir?
https://www.extendoffice.com/documents/excel/4656-excel-send-email-based-on-cell-value.html sorunu çözmenize yardımcı olabilir.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Yönetici Sevgili


Yardımınıza ihtiyaçım var,



Sahadan çalışanımız tarafından yapılan günlük iş detaylarını izlemek için bir excel'im var, bu yüzden bu adam o excel sayfasındaki verileri belirli bir zamanda güncelleyemezse, excel sayfasından bir postayı tetiklemek mümkün mü?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba,
Bu konuda yardımcı olamam.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Adres yerine hücre değerini göndermek istersem kodda neyi değiştirmeliyim?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba,
Aşağıdaki VBA kodunu deneyebilirsiniz.

Özel Alt Çalışma Alanı_Değiştir (ByVal Target As Range)
Aralık olarak Dim xRgSel
xOutApp'i Nesne Olarak Karartın
Nesne Olarak xMailItem'i Karartın
Dize olarak xMailBody'yi karart
On Error Resume Next
Application.ScreenUpdating = Yanlış
Application.DisplayAlerts = Yanlış
xRg = Aralık ("A2:E11") olarak ayarla
xRgSel'i ayarla = Kesiştir(Hedef, xRg)
ActiveWorkbook.Save
xRgSel Değilse O Zaman Hiçbir Şey Değilse
xOutApp = CreateObject("Outlook.Application") olarak ayarlayın
xMailItem = xOutApp.CreateItem(0) olarak ayarlayın
xMailBody = "Hücre(ler)" & xRgSel.Address(Yanlış, Yanlış) & _
xRgSel.Value & _
" çalışma sayfasındaki '" & Me.Name & "', " & _ üzerinde değiştirildi
Format$(Şimdi, "aa/gg/yyyy") & " at " & Format$(Şimdi, "ss:dd:ss") & _
" tarafından " & Environ$("kullanıcı adı") & "."

xMailItem ile
.To = "E-posta Adresi"
.Subject = "Çalışma sayfası değiştirildi" & ThisWorkbook.FullName
.Body = xMailBody
.Ekler.Add (ThisWorkbook.FullName)
.Görüntüle
İle bitmek
xRgSel'i ayarla = Hiçbir şey
xOutApp'ı ayarla = Hiçbir şey
xMailItem'i ayarla = Hiçbir şey
Eğer son
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Tüm hücre değerini değil de yalnızca o hücredeki güncellenmiş yorumları istiyorsak, yalnızca hücreye eklenen en son yorumları göstermelidir.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bunu anladın mı?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Harika bilgi.
E-postaya eklenebilecek bilgilerle ilgili soru.
Yukarıdaki örneğinizi kullanarak ....

F4'te bir değeriniz olsaydı, D4 değiştirildiğinde oluşturulan e-postaya F4 Değerini nasıl eklerdiniz?
Bu yorum sitedeki moderatör tarafından en aza indirildi
o zaman tüm satırı göndermek zorunda kalırsam?
Bu yorum sitedeki moderatör tarafından en aza indirildi
VBA kodunun üzerinde denedim: Excel'de belirli bir aralıktaki hücre değiştirilirse e-posta gönder. Bu VBA, e-posta göndermek dışında benim için çalışıyor. Veriler verilen aralıkta değiştirildiğinde, değiştirilmiş hücre ayrıntılarıyla otomatik olarak bir e-posta oluşturulur. Ancak, e-posta alıcıya otomatik olarak gönderilmez ve kullanıcının e-postadaki gönder düğmesine tıklaması gerekir. Burada aradığım şey, e-postanın oluşturulduğunda alıcılara otomatik olarak gönderilmesi gerektiğidir. Lütfen bunun için bir kod sağlamama yardım edin. Çok teşekkürler
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Jimmy Joseph,
Lütfen ".Display" satırını ".Send" ile değiştirin. Umarım yardımcı olabilirim. Yorum yaptığınız için teşekkürler.
Bu yorum sitedeki moderatör tarafından en aza indirildi
merhaba; diğer hücrelerden (ilk satırdan ve ilk sütundan) gelen bilgiler kullanılarak görüntülenen metni değiştirmenin bir yolu var mı? örneğin, K15 hücresini değiştirirsem, mesaj bilgisine A15 ve K1 hücrelerini dahil etmek ister miyim? kodda neyi değiştirmeliyim? çok teşekkürler
Bu yorum sitedeki moderatör tarafından en aza indirildi
merhaba Laona. bunu nasıl yapabileceğini buldun mu
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba. Başka bir hücre aralığı düzenlenirse, bir e-postanın başka bir e-posta adresine gönderilmesi için kodu nasıl değiştirebilirim?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bu istekle ilgili herhangi bir yardım var mı? Aynı sorunu yaşıyorum. Satır başına birden çok e-posta adresi eklemek istiyorum, ancak bir satırı değiştirdiğimde çalışma sayfasının tamamı değişiyor. Değişiklikleri yalnızca bir satırla nasıl sınırlayabilirim?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Çizgiyi düzenle:
1). Kodda, A2:E11, e-posta göndereceğiniz aralıktır.
ve
3). E-posta Adresini alıcının e-posta adresi ile değiştirin .To = "E-posta Adresi".

İyi çalışıyor.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Lütfen bunu daha fazla açıklayabilir misiniz? Değiştirilmekte olan başka bir aralığa göre farklı bir e-postaya göndermek için kodu nasıl tekrarlarsınız. Aşağıdaki kodu kopyalayıp yapıştırmayı ve yorumunuza göre değiştirmeyi denedim, ancak yine de yalnızca ilk aralık komutu yürütüyor ve e-postayı yazıyor gibi görünüyor.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Buna bir cevabı olan var mı?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, sayfada değiştirilen bir değeri kullanarak sayfama e-posta göndermeye çalışıyordum. H sütununda durum ="4" olarak değiştirilecekse, soldaki Sipariş Kimliği bir kullanıcıya gönderilmelidir. Sayfa dinamik olarak çalışıyor, bu yüzden sipariş kimliklerinin saklandığı ve durum değişikliklerinin H9:H140'ta aynı aralıkta yapıldığı D9:D140 Aralığım var. Durum ="4" olarak değiştirildiğinde bunu yapma hedefine nasıl ulaşabilir ve Sipariş Kimliğini müşterime nasıl gönderebilirim?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Değiştirilen hücre adresleri yerine aynı sütunda xMailBody'de farklı bir referans hücre görüntülemek mümkün müdür?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Sam, Değiştirilen hücre adresinin aynı sütununda rastgele bir referans hücre mi seçmek istiyorsunuz? Yoksa kodun xMailBody satırına manuel olarak bir referans hücre mi yazın? Kodda bir referans hücreyi manuel olarak yazmak kolaydır, referans hücresini aşağıda gösterildiği gibi çift tırnak içine alın: xMailBody = "Hücre(ler)" & "D3" & ", " & "D8" & _

Bu yorum sitedeki moderatör tarafından en aza indirildi
Bunu, yalnızca bir aralıktaki bir hücre "Evet" olarak değiştirildiğinde e-postayı gösterecek şekilde değiştirmek mümkün mü? Başka bir değer ise hiçbir şey yapmamasını isterim.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Kod için teşekkürler, değeri girip enter tuşuna bastığımda bu kod çalışıyor. Ancak benim durumumda hücre otomatik olarak formülle doluyor ve değere ulaşıldığında e-postayı açmıyor, bu nedenle kod bu durumda çalışmıyor. Şimdiden teşekkür ederim!
Bu yorum sitedeki moderatör tarafından en aza indirildi
merhaba hakan,
Aşağıdaki VBA kodu, sorunu çözmenize yardımcı olabilir. Lütfen bir deneyin. Geri bildiriminiz için teşekkür ederiz.

Private Sub Worksheet_Change(ByVal Target As Range)
'Tarafından güncellendi Extendoffice 2022/04/15
Aralık olarak Dim xRgSel
xOutApp'i Nesne Olarak Karartın
Nesne Olarak xMailItem'i Karartın
Dize olarak xMailBody'yi karart
Dim xBoolean olarak Boolean
Aralık olarak Dim xItsRG
Aralık Olarak Dim xDDs
Aralık olarak Dim xDs
On Error Resume Next
Application.ScreenUpdating = Yanlış
Application.DisplayAlerts = Yanlış
xBoole = Yanlış
xRg = Aralık ("E2:E13") olarak ayarla

xItsRG olarak ayarlayın = Kesiştir(Hedef, xRg)
xDD'leri ayarla = Intersect(Target.DirectDependents, xRg)
Set xDs = Intersect(Target.Dependents, xRg)
Değilse (xItsRG Hiçbir Şey Değildir) O Zaman
xRgSel = xItsRG olarak ayarlayın
xBoole = Doğru
ElseIf Not (xDDs Hiçbir Şey Değildir) O zaman
xRgSel = xDD'leri ayarla
xBoole = Doğru
ElseIf Değilse (xDs Hiçbir Şey Değildir) O zaman
xRgSel = xDs ayarla
xBoole = Doğru
Eğer son


ActiveWorkbook.Save
Eğer xBoolean ise
Debug.Print xRgSel.Address


xOutApp = CreateObject("Outlook.Application") olarak ayarlayın
xMailItem = xOutApp.CreateItem(0) olarak ayarlayın
xMailBody = "Hücre(ler)" & xRgSel.Address(Yanlış, Yanlış) & _
" çalışma sayfasındaki '" & Me.Name & "', " & _ üzerinde değiştirildi
Format$(Şimdi, "aa/gg/yyyy") & " at " & Format$(Şimdi, "ss:dd:ss") & _
" tarafından " & Environ$("kullanıcı adı") & "."

xMailItem ile
.To = "E-posta Adresi"
.Subject = "Çalışma sayfası değiştirildi" & ThisWorkbook.FullName
.Body = xMailBody
.Ekler.Add (ThisWorkbook.FullName)
.Görüntüle
İle bitmek
xRgSel'i ayarla = Hiçbir şey
xOutApp'ı ayarla = Hiçbir şey
xMailItem'i ayarla = Hiçbir şey
Eğer son
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, buna benzer bir kod oluşturdum ancak bir hücre değeri silinirse, kaydedildiğinde/kapatıldığında e-posta gönderilmeyeceği bir durumu *** istiyorum. Yalnızca bir hücre değeri girildiğinde bir e-posta gönderir. Bunun nasıl yapılacağını biliyor musun? Bu benim kodum:

EXCEL İŞ KİTABI GÜNCELLENDİĞİNDE BİRİSİNE OTOMATİK E-POSTA KODU

SAYFA KODU:

Seçenek Açık 'Excel çalışma sayfası değişiklik olay Aralığı
Özel Alt Çalışma Alanı_Değiştir (ByVal Target As Range)
Kesişmiyorsa(Hedef, Aralık("C3:D62")) O Zaman Hiçbir Şey Değildir
'Target.EntireRow.Interior.ColorIndex = 15
Aralık("XFD1048576").Değer = 15
Eğer son
Kesişmiyorsa(Hedef, Aralık("I3:J21")) O Zaman Hiçbir Şey Değildir
'Target.EntireRow.Interior.ColorIndex = 15
Aralık("XFD1048576").Değer = 15
Eğer son
End Sub


ÇALIŞMA KİTABI KODU:

Özel Sub Workbook_BeforeClose (Boole Olarak İptal Et)
Eğer Me.Saved = False O zaman Me.Save

xOutApp'i Nesne Olarak Karartın
Nesne Olarak xMailItem'i Karartın
Dim xName As Dize

Eğer Aralık("XFD1048576").Value = 15 O zaman
On Error Resume Next
xOutApp = CreateObject("Outlook.Application") olarak ayarlayın
xMailItem = xOutApp.CreateItem(0) olarak ayarlayın
xName = ActiveWorkbook.FullName
xMailItem ile
.To = "e-posta"
.CC = ""
.Subject = "mesaj"
.Body = "mesaj!"
.Ekler.*** xName
.Görüntüle
'.göndermek
İle bitmek
Eğer son
xMailItem'i ayarla = Hiçbir şey
xOutApp'ı ayarla = Hiçbir şey



End Sub

Özel Sub Workbook_Open ()
Aralık("XFD1048576").Temizle
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba,

Der Code würde gut für mein Vorhaben passen, aber gibt es die Möglichkeit, dass er eine E-Mail beim speichern schreibt mit allen Zellen die geändert wurden? Yani şarkı sözleri: Bu yüzden en güzel sevgilin Zelle einzeln senden. Dies ist dann problematisch wenn zB 10 Zellen angepasst werden, 10 E-Mails bedeuten würde idi. 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.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Esser123,
Aşağıdaki VBA kodları yardımcı olabilir. Belirtilen aralıktaki hücreleri değiştirdikten ve çalışma kitabını kaydettikten sonra, e-posta gövdesindeki tüm değiştirilmiş hücreleri listeleyen bir e-posta açılır ve çalışma kitabı da e-postaya ek olarak eklenir. Lütfen aşağıdaki adımları izleyin:
1. Temel olarak e-posta göndermek istediğiniz hücreleri içeren çalışma sayfasını açın, sayfa sekmesine sağ tıklayın ve tıklayın. Kodu Görüntüle sağ tıklama menüsünden. Ardından aşağıdaki kodu sayfa(kod) penceresine kopyalayın.
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. Visual Basic düzenleyicisinde çift tıklayın Bu Çalışma Kitabı sol bölmede, ardından aşağıdaki VBA kodunu kopyalayın. Bu Çalışma Kitabı (Kod) pencere.
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
Buraya henüz hiç yorum yapılmamış
Lütfen yorum yazın
Misafir olarak yayınlama
×
Bu gönderiyi değerlendirin:
0   Karakterler
Önerilen Konumlar