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

จะส่งอีเมลได้อย่างไรหากมีการแก้ไขเซลล์บางเซลล์ใน Excel

บทความนี้กล่าวถึงการส่งอีเมลผ่าน Outlook เมื่อมีการแก้ไขเซลล์ในช่วงที่กำหนดใน Excel

ส่งอีเมลหากเซลล์ในช่วงหนึ่งถูกแก้ไขด้วยรหัส VBA


ส่งอีเมลหากเซลล์ในช่วงหนึ่งถูกแก้ไขด้วยรหัส VBA

ถ้าคุณต้องการสร้างอีเมลใหม่โดยอัตโนมัติโดยแนบสมุดงานที่ใช้งานอยู่เมื่อเซลล์ในช่วง A2:E11 ถูกแก้ไขในแผ่นงานบางแผ่น รหัส VBA ต่อไปนี้สามารถช่วยคุณได้

1. ในแผ่นงานที่คุณต้องส่งอีเมลตามเซลล์ที่แก้ไขในช่วงหนึ่งให้คลิกขวาที่แท็บแผ่นงานจากนั้นคลิก ดูรหัส จากเมนูบริบท ดูภาพหน้าจอ:

2. ในการโผล่ขึ้นมา Microsoft Visual Basic สำหรับแอปพลิเคชัน โปรดคัดลอกและวางโค้ด VBA ด้านล่างลงในหน้าต่างรหัส

รหัส VBA: ส่งอีเมลหากเซลล์ในช่วงที่ระบุถูกแก้ไขใน 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

หมายเหตุ:

1). ในรหัส A2: E11 คือช่วงที่คุณจะส่งอีเมลตาม
2). โปรดเปลี่ยนเนื้อหาอีเมลตามที่คุณต้องการ xMailBody บรรทัดในรหัส
3). แทนที่ ที่อยู่อีเมล ด้วยที่อยู่อีเมลของผู้รับในบรรทัด . ถึง = "ที่อยู่อีเมล".
4). เปลี่ยนหัวเรื่องอีเมลในบรรทัด .Subject = "แผ่นงานแก้ไขใน" & ThisWorkbook.FullName.

3 กด อื่น ๆ + Q พร้อมกันเพื่อปิดไฟล์ Microsoft Visual Basic สำหรับแอปพลิเคชัน หน้าต่าง

จากนี้ไปเซลล์ใด ๆ ในช่วง A2: E11 จะถูกแก้ไขอีเมลใหม่จะถูกสร้างขึ้นพร้อมแนบสมุดงานที่อัปเดตแล้ว และฟิลด์ที่ระบุทั้งหมดเช่นหัวเรื่องผู้รับและเนื้อหาอีเมลจะแสดงอยู่ในอีเมล กรุณาส่งอีเมล

หมายเหตุ: รหัส VBA ใช้ได้เฉพาะเมื่อคุณใช้ Outlook เป็นโปรแกรมอีเมลของคุณ


บทความที่เกี่ยวข้อง:


เครื่องมือเพิ่มประสิทธิภาพการทำงานในสำนักงานที่ดีที่สุด

Kutools สำหรับ Excel แก้ปัญหาส่วนใหญ่ของคุณและเพิ่มผลผลิตของคุณได้ถึง 80%

  • นำมาใช้ใหม่: ใส่อย่างรวดเร็ว สูตรที่ซับซ้อนแผนภูมิ และสิ่งที่คุณเคยใช้มาก่อน เข้ารหัสเซลล์ ด้วยรหัสผ่าน; สร้างรายชื่อผู้รับจดหมาย และส่งอีเมล ...
  • ซุปเปอร์ฟอร์มูล่าบาร์ (แก้ไขข้อความและสูตรหลายบรรทัดได้อย่างง่ายดาย); การอ่านเค้าโครง (อ่านและแก้ไขเซลล์จำนวนมากได้อย่างง่ายดาย); วางลงในช่วงที่กรองแล้ว...
  • ผสานเซลล์ / แถว / คอลัมน์ โดยไม่สูญเสียข้อมูล แยกเนื้อหาของเซลล์ รวมแถว / คอลัมน์ที่ซ้ำกัน... ป้องกันเซลล์ซ้ำ; เปรียบเทียบช่วง...
  • เลือกซ้ำหรือไม่ซ้ำ แถว; เลือกแถวว่าง (เซลล์ทั้งหมดว่างเปล่า); Super Find และ Fuzzy Find ในสมุดงานจำนวนมาก สุ่มเลือก ...
  • สำเนาถูกต้อง หลายเซลล์โดยไม่เปลี่ยนการอ้างอิงสูตร สร้างการอ้างอิงอัตโนมัติ ถึงหลายแผ่น ใส่สัญลักษณ์แสดงหัวข้อย่อย, กล่องกาเครื่องหมายและอื่น ๆ ...
  • แยกข้อความ, เพิ่มข้อความ, ลบตามตำแหน่ง, ลบ Space; สร้างและพิมพ์ผลรวมย่อยของเพจ แปลงระหว่างเนื้อหาของเซลล์และความคิดเห็น...
  • ซุปเปอร์ฟิลเตอร์ (บันทึกและใช้โครงร่างตัวกรองกับแผ่นงานอื่น ๆ ); การเรียงลำดับขั้นสูง ตามเดือน / สัปดาห์ / วันความถี่และอื่น ๆ ตัวกรองพิเศษ โดยตัวหนาตัวเอียง ...
  • รวมสมุดงานและแผ่นงาน; ผสานตารางตามคอลัมน์สำคัญ แยกข้อมูลออกเป็นหลายแผ่น; Batch แปลง xls, xlsx และ PDF...
  • คุณสมบัติที่ทรงพลังมากกว่า 300 รายการ. รองรับ Office/Excel 2007-2021 และ 365 รองรับทุกภาษา ง่ายต่อการปรับใช้ในองค์กรหรือองค์กรของคุณ คุณสมบัติเต็มรูปแบบ ทดลองใช้ฟรี 30 วัน รับประกันคืนเงินภายใน 60 วัน
kte แท็บ 201905

แท็บ Office นำอินเทอร์เฟซแบบแท็บมาที่ Office และทำให้งานของคุณง่ายขึ้นมาก

  • เปิดใช้งานการแก้ไขและอ่านแบบแท็บใน Word, Excel, PowerPoint, ผู้จัดพิมพ์, Access, Visio และโครงการ
  • เปิดและสร้างเอกสารหลายรายการในแท็บใหม่ของหน้าต่างเดียวกันแทนที่จะเป็นในหน้าต่างใหม่
  • เพิ่มประสิทธิภาพการทำงานของคุณ 50% และลดการคลิกเมาส์หลายร้อยครั้งให้คุณทุกวัน!
ด้านล่าง officetab
จัดเรียงความคิดเห็นโดย
ความคิดเห็น (37)
ยังไม่มีการให้คะแนน เป็นคนแรกที่ให้คะแนน!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันติดอยู่ในรหัส VB ​​ด้านล่าง ฉันกำลังพยายามรับการแจ้งเตือนทางอีเมลถึงผู้ใช้ที่มีการเปลี่ยนแปลงข้อมูล อีเมลใช้งานได้ แต่เมื่อฉันทำการเปลี่ยนแปลงใดๆ อีเมลที่เริ่มต้นในครั้งเดียว แต่ฉันต้องการอีเมลเมื่อบันทึกและปิดแผ่นงาน excel หลังจากทำการเปลี่ยนแปลงทั้งหมดกับผู้ใช้ทั้งหมดที่ได้รับผลกระทบ นอกจากนี้ยังควรใช้งานได้กับแผ่นงานใด ๆ ในสมุดงาน Excel ทั้งหมด

โปรดช่วย ...

สมุดงานย่อยส่วนตัว_ก่อนบันทึก (ByVal SaveAsUI เป็นบูลีน ยกเลิกเป็นบูลีน)

'****การประกาศของวัตถุและตัวแปร******

Dim xRgSel เป็นช่วง Dim xOutApp เป็นวัตถุ Dim xMailItem เป็นวัตถุ Dim xMailBody เป็นสตริง Dim mailTo เป็นสตริง

เกี่ยวกับข้อผิดพลาดต่อไป

ชีต("TargetSheet")).ช่วง("TargetRange")).Select

Application.ScreenUpdating = เท็จ Application.DisplayAlerts = เท็จ

'ตั้งค่า xRg = Range("A" & Rows.Count).End(xlUp).Row

ตั้งค่า xRg = ช่วง ("A2:DA1000")
ตั้งค่า xRgSel = อินเตอร์เซก (เป้าหมาย xRg)


ActiveWorkbook บันทึก
'********** การเปิดแอปพลิเคชัน Outlook ***********

ถ้าไม่ใช่ xRgSel ก็ไม่มีอะไรทั้งนั้น

ตั้งค่า xOutApp = CreateObject("Outlook.Application")
ตั้งค่า xMailItem = xOutApp.CreateItem(0)

xMailBody = "เซลล์" & xRgSel.Address (เท็จ เท็จ) & _
" ในแผ่นงาน '" & Me.Name & "' ถูกแก้ไขเมื่อ " & _
Format$(ตอนนี้ "mm/dd/yyyy") & " ที่ " & Format$(ตอนนี้ "hh:mm:ss") & _
" โดย " & Environ$("ชื่อผู้ใช้") & "."
'***********กำลังค้นหารายชื่อผู้รับ************

ถ้า Cells(xRgSel.Row, "A").Value = "Pankaj" แล้ว

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

End If

ถ้า Cells(xRgSel.Row, "A")).Value = "Nitin" แล้ว

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

End If

ถ้า Cells(xRgSel.Row, "A")).Value = "Chandan" แล้ว

mailTo = "pakxro**@gmail.com"

End If
'*************การเขียนอีเมล*************

ด้วย xMailItem

.ถึง = mailTo
.Subject = "แผ่นงานแก้ไขใน" & ThisWorkbook.FullName
.Body = xMailBody
'.Attachments.Add (ThisWorkbook.FullName)
.แสดง

จบด้วย

ตั้งค่า xRgSel = Nothing
ตั้งค่า xOutApp = Nothing
ตั้งค่า xMailItem = Nothing

End If

Application.DisplayAlerts = จริง
Application.ScreenUpdating = จริง
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
เรียน ปัญจจ ชุกลา
โพสต์คำถาม Excel ของคุณในฟอรัม: https://www.extendoffice.com/forum.html เพื่อรับการสนับสนุนเพิ่มเติมเกี่ยวกับ Excel จากผู้เชี่ยวชาญ Excel ของเรา
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันสามารถสร้างมาโครได้ แต่ฉันมีปัญหา ฉันต้องการส่งอีเมลโดยอัตโนมัติเมื่อเซลล์ถึงเกณฑ์ที่กำหนด เซลล์เป็นสูตร เมื่อผลรวมคำนวณต่ำกว่าเกณฑ์ดังกล่าว จะไม่ทำอะไรเลย อย่างไรก็ตาม หากฉันพิมพ์ลงในเซลล์โดยตรง ระบบจะประมวลผลมาโครตามที่วางแผนไว้ สูตรเลอะแมโครหรือไม่?
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ซิสซี่ โจนส์
วิธีการในบทความนี้: วิธีการส่งอีเมลโดยอัตโนมัติตามค่าของเซลล์ใน Excel?
https://www.extendoffice.com/documents/excel/4656-excel-send-email-based-on-cell-value.html อาจช่วยคุณแก้ปัญหาได้
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ธุรการเรียน


ฉันต้องการความช่วยเหลือจากคุณ,



ฉันมี excel ในการตรวจสอบรายละเอียดงานที่ทำในแต่ละวันโดยพนักงานของเราจากภาคสนาม เป็นไปได้ไหมที่จะเรียกเมลจากแผ่นงาน excel หากผู้ชายคนนั้นไม่สามารถอัปเดตข้อมูลในแผ่นงาน excel นั้นในเวลาที่กำหนด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี
ช่วยไม่ได้
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ถ้าฉันต้องการส่งค่าเซลล์แทนที่อยู่..แล้วจะต้องเปลี่ยนอะไรในโค้ด?
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี
คุณสามารถลองใช้โค้ด VBA ด้านล่าง

Worksheet_Change ย่อยส่วนตัว (เป้าหมายเป็นช่วง ByVal)
Dim xRgSel เป็นช่วง
Dim xOutApp เป็นวัตถุ
Dim xMailItem เป็นวัตถุ
Dim xMailBody เป็นสตริง
เกี่ยวกับข้อผิดพลาดต่อไป
Application.ScreenUpdating = เท็จ
Application.DisplayAlerts = เท็จ
ตั้งค่า xRg = ช่วง ("A2:E11")
ตั้งค่า xRgSel = อินเตอร์เซก (เป้าหมาย xRg)
ActiveWorkbook บันทึก
ถ้าไม่ใช่ xRgSel ก็ไม่มีอะไรทั้งนั้น
ตั้งค่า xOutApp = CreateObject("Outlook.Application")
ตั้งค่า xMailItem = xOutApp.CreateItem(0)
xMailBody = "เซลล์" & xRgSel.Address (เท็จ เท็จ) & _
xRgSel.ค่า & _
" ในแผ่นงาน '" & Me.Name & "' ถูกแก้ไขเมื่อ " & _
Format$(ตอนนี้ "mm/dd/yyyy") & " ที่ " & Format$(ตอนนี้ "hh:mm:ss") & _
" โดย " & Environ$("ชื่อผู้ใช้") & "."

ด้วย xMailItem
. ถึง = "ที่อยู่อีเมล"
.Subject = "แผ่นงานแก้ไขใน" & ThisWorkbook.FullName
.Body = xMailBody
.Attachments.Add (ThisWorkbook.FullName)
.แสดง
จบด้วย
ตั้งค่า xRgSel = Nothing
ตั้งค่า xOutApp = Nothing
ตั้งค่า xMailItem = Nothing
End If
Application.DisplayAlerts = จริง
Application.ScreenUpdating = จริง
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
จะเป็นอย่างไรถ้าเราต้องการเฉพาะความคิดเห็นที่อัปเดตในเซลล์นั้น ไม่ใช่ค่าเซลล์ทั้งหมด ควรแสดงเฉพาะความคิดเห็นล่าสุดที่เพิ่มในเซลล์
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
คุณคิดออกไหม
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ข้อมูลที่ดี
คำถามเกี่ยวกับข้อมูลที่สามารถเพิ่มลงในอีเมลได้
ใช้ตัวอย่างของคุณด้านบน....

หากคุณมีค่าใน F4 คุณจะรวมค่า F4 ไว้ในอีเมลที่สร้างขึ้นเมื่อ D4 ได้รับการแก้ไขอย่างไร
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ถ้าฉันต้องส่งทั้งแถวล่ะ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันได้ลองใช้โค้ด VBA ข้างต้นแล้ว: ส่งอีเมลหากเซลล์ในช่วงที่ระบุถูกแก้ไขใน Excel VBA นี้ใช้งานได้สำหรับฉันยกเว้นการส่งอีเมล เมื่อข้อมูลถูกแก้ไขในช่วงที่กำหนด อีเมลจะถูกสร้างขึ้นโดยอัตโนมัติพร้อมรายละเอียดเซลล์ที่แก้ไข อย่างไรก็ตาม อีเมลจะไม่ส่งถึงผู้รับโดยอัตโนมัติ และผู้ใช้ต้องคลิกปุ่มส่งในอีเมล สิ่งที่ฉันดูอยู่นี้คือ อีเมลต้องส่งถึงผู้รับโดยอัตโนมัติเมื่อมีการสร้างอีเมล โปรดช่วยฉันระบุรหัสสำหรับสิ่งนี้ ขอบคุณมาก
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีจิมมี่ โจเซฟ
โปรดแทนที่บรรทัด ".Display" ด้วย ".Send" หวังว่าฉันจะช่วยได้ ขอบคุณสำหรับความคิดเห็น
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี; มีวิธีเปลี่ยนข้อความที่แสดงโดยใช้ข้อมูลจากเซลล์อื่น (จากแถวแรกและคอลัมน์แรก) หรือไม่ ตัวอย่างเช่น ถ้าฉันเปลี่ยนเซลล์ K15 ฉันต้องการรวมข้อมูลข้อความในเซลล์ A15 และ K1 หรือไม่ ฉันควรเปลี่ยนรหัสอะไร ขอบคุณมาก
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ลาน่า. คุณรู้หรือไม่ว่าจะทำสิ่งนี้ได้อย่างไร
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ฉันจะแก้ไขรหัสเพื่อให้อีเมลถูกส่งไปยังที่อยู่อีเมลอื่นได้อย่างไรหากมีการแก้ไขช่วงของเซลล์อื่น
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ความช่วยเหลือใด ๆ ในคำขอนี้ ฉันมีปัญหาเดียวกัน ฉันต้องการเพิ่มที่อยู่อีเมลหลายรายการต่อแถว แต่เมื่อฉันเปลี่ยนหนึ่งแถว แผ่นงานทั้งหมดจะเปลี่ยนไป ฉันจะจำกัดการเปลี่ยนแปลงเพียงแถวเดียวเท่านั้นได้อย่างไร
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
แก้ไข linie:
1). ในรหัส A2:E11 คือช่วงที่คุณจะส่งอีเมลตาม
และ
3). แทนที่ที่อยู่อีเมลด้วยที่อยู่อีเมลของผู้รับในบรรทัด .To = "ที่อยู่อีเมล"

ทำงานได้ดี
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
คุณช่วยอธิบายเพิ่มเติมได้ไหม คุณทำซ้ำรหัสเพื่อส่งไปยังอีเมลอื่นโดยพิจารณาจากช่วงอื่นที่กำลังแก้ไขได้อย่างไร ฉันได้ลองคัดลอกและวางโค้ดด้านล่างแล้วเปลี่ยนตามความคิดเห็นของคุณ แต่ดูเหมือนว่าจะมีเพียงช่วงแรกเท่านั้นที่เรียกใช้คำสั่งและเขียนอีเมล
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ไม่มีใครมีคำตอบนี้?
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ฉันกำลังพยายามส่งอีเมลบนแผ่นงานของฉันโดยใช้ค่าเดียวที่เปลี่ยนแปลงบนแผ่นงาน หากในคอลัมน์ H สถานะจะเปลี่ยนเป็น ="4" รหัสคำสั่งซื้อทางด้านซ้ายควรถูกส่งไปยังผู้ใช้หนึ่งราย แผ่นงานทำงานแบบไดนามิก ดังนั้นฉันจึงมีช่วงตั้งแต่ D9:D140 โดยที่เก็บรหัสคำสั่งซื้อและการเปลี่ยนแปลงสถานะจะทำในช่วงเดียวกันใน H9:H140 ฉันจะบรรลุเป้าหมายและส่งรหัสคำสั่งซื้อให้กับลูกค้าของฉันได้อย่างไรเมื่อสถานะเปลี่ยนเป็น ="4"
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
เป็นไปได้ไหมที่จะแสดงเซลล์อ้างอิงอื่นใน xMailBody ในคอลัมน์เดียวกันแทนที่จะเป็นที่อยู่ของเซลล์ที่แก้ไข
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีแซม คุณหมายถึงการเลือกเซลล์อ้างอิงแบบสุ่มในคอลัมน์เดียวกันของที่อยู่เซลล์ที่แก้ไขหรือไม่ หรือพิมพ์เซลล์อ้างอิงด้วยตนเองในบรรทัด xMailBody ของรหัส การพิมพ์เซลล์อ้างอิงในโค้ดด้วยตนเองนั้นทำได้ง่าย เพียงปิดเซลล์อ้างอิงด้วยเครื่องหมายคำพูดคู่ดังที่แสดงด้านล่าง: xMailBody = "Cell(s) " & "D3" & ", " & "D8" & _

ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
เป็นไปได้ไหมที่จะเปลี่ยนแปลงเพื่อให้แสดงอีเมลเฉพาะในกรณีที่เซลล์ในช่วงที่มีการเปลี่ยนแปลงเป็น "ใช่" อยากจะให้มันไม่ทำอะไรเลยถ้ามันมีค่าอื่น
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ขอบคุณสำหรับรหัส รหัสนี้ใช้งานได้เมื่อฉันป้อนค่าและกด Enter แต่ในกรณีของฉัน เซลล์จะเติมสูตรโดยอัตโนมัติ และเมื่อถึงค่า เซลล์จะไม่เปิดอีเมล ดังนั้นโค้ดจะไม่ทำงานในกรณีนี้ ขอบคุณล่วงหน้า!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ฮาคานะ
รหัส VBA ต่อไปนี้สามารถช่วยคุณแก้ปัญหาได้ กรุณาให้มันลอง ขอบคุณสำหรับความคิดเห็นของคุณ.

แผ่นงานย่อยส่วนตัว_เปลี่ยน (ByVal Target As Range)
'ปรับปรุงโดย Extendoffice 2022 / 04 / 15
Dim xRgSel เป็นช่วง
Dim xOutApp เป็นวัตถุ
Dim xMailItem เป็นวัตถุ
Dim xMailBody เป็นสตริง
Dim xBoolean เป็นบูลีน
Dim xItsRG เป็นช่วง
Dim xDDs เป็นช่วง
Dim xDs เป็นช่วง
เกี่ยวกับข้อผิดพลาดต่อไป
Application.ScreenUpdating = เท็จ
Application.DisplayAlerts = เท็จ
xBoolean = เท็จ
ตั้งค่า xRg = ช่วง ("E2:E13")

ตั้งค่า xItsRG = ตัดกัน (เป้าหมาย xRg)
ตั้งค่า xDDs = Intersect (Target.DirectDependents, xRg)
ตั้งค่า xDs = อินเตอร์เซก (Target.Dependents, xRg)
ถ้าไม่ใช่ (xItsRG Is Nothing) งั้น
ตั้งค่า xRgSel = xItsRG
xBoolean = จริง
ElseIf Not (xDDs Is Nothing) ถ้าอย่างนั้น
ตั้งค่า xRgSel = xDDs
xBoolean = จริง
ElseIf Not (xDs Is Nothing) ถ้าอย่างนั้น
ตั้งค่า xRgSel = xDs
xBoolean = จริง
End If


ActiveWorkbook บันทึก
ถ้า xBoolean แล้ว
Debug.Print xRgSel.Address


ตั้งค่า xOutApp = CreateObject("Outlook.Application")
ตั้งค่า xMailItem = xOutApp.CreateItem(0)
xMailBody = "เซลล์" & xRgSel.Address (เท็จ เท็จ) & _
" ในแผ่นงาน '" & Me.Name & "' ถูกแก้ไขเมื่อ " & _
Format$(ตอนนี้ "mm/dd/yyyy") & " ที่ " & Format$(ตอนนี้ "hh:mm:ss") & _
" โดย " & Environ$("ชื่อผู้ใช้") & "."

ด้วย xMailItem
. ถึง = "ที่อยู่อีเมล"
.Subject = "แผ่นงานแก้ไขใน" & ThisWorkbook.FullName
.Body = xMailBody
.Attachments.Add (ThisWorkbook.FullName)
.แสดง
จบด้วย
ตั้งค่า xRgSel = Nothing
ตั้งค่า xOutApp = Nothing
ตั้งค่า xMailItem = Nothing
End If
Application.DisplayAlerts = จริง
Application.ScreenUpdating = จริง
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ฉันได้สร้างรหัสที่คล้ายกันแล้ว แต่ฉันต้องการ *** เงื่อนไขที่หากค่าของเซลล์ถูกลบซึ่งจะไม่ส่งอีเมลเมื่อมีการบันทึก/ปิด มันจะส่งอีเมลเมื่อมีการป้อนค่าของเซลล์เท่านั้น คุณรู้วิธีการทำสิ่งนี้หรือไม่? นี่คือรหัสของฉัน:

รหัสสำหรับอีเมลอัตโนมัติถึงใครบางคนเมื่อมีการอัปเดตเวิร์กบุ๊ก EXCEL

รหัสแผ่นงาน:

ตัวเลือกที่ชัดเจน 'ช่วงเหตุการณ์การเปลี่ยนแปลงแผ่นงาน Excel
Worksheet_Change ย่อยส่วนตัว (เป้าหมายเป็นช่วง ByVal)
ถ้าไม่ตัดกัน(Target, Range("C3:D62")) ก็ไม่มีอะไรทั้งนั้น
'Target.EntireRow.Interior.ColorIndex = 15
ช่วง ("XFD1048576") ค่า = 15
End If
ถ้าไม่ตัดกัน(Target, Range("I3:J21")) ก็ไม่มีอะไรทั้งนั้น
'Target.EntireRow.Interior.ColorIndex = 15
ช่วง ("XFD1048576") ค่า = 15
End If
ย่อยสิ้นสุด


รหัสสมุดงาน:

สมุดงานย่อยส่วนตัว_ก่อนปิด(ยกเลิกเป็นบูลีน)
If Me.Saved = เท็จ งั้น Me.Save

Dim xOutApp เป็นวัตถุ
Dim xMailItem เป็นวัตถุ
Dim xName เป็นสตริง

ถ้า Range("XFD1048576") .Value = 15 แล้ว
เกี่ยวกับข้อผิดพลาดต่อไป
ตั้งค่า xOutApp = CreateObject("Outlook.Application")
ตั้งค่า xMailItem = xOutApp.CreateItem(0)
xname = activeworkbook.fullName
ด้วย xMailItem
.To = "อีเมล"
.CC = ""
.Subject = "ข้อความ"
.Body = "ข้อความ!"
.สิ่งที่แนบมา.*** xชื่อ
.แสดง
'.ส่ง
จบด้วย
End If
ตั้งค่า xMailItem = Nothing
ตั้งค่า xOutApp = Nothing



ย่อยสิ้นสุด

สมุดงานย่อยส่วนตัว_Open()
ช่วง("XFD1048576") ชัดเจน
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีทุก

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? ดังนั้น wie es jetzt ist ,würde er jede geänderte Zelle einzeln senden Dies ist dann problematisch wenn zB 10 Zellen angepasst werden was 10 E-Mails อีเมล 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 ใน die E-Mail, wenn aber jemand anders Filtert wird er die Änderung nicht mehr finden.
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี Esser123,
รหัส VBA ต่อไปนี้สามารถช่วยได้ หลังจากแก้ไขเซลล์ในช่วงที่ระบุและบันทึกเวิร์กบุ๊กแล้ว อีเมลจะปรากฏขึ้นเพื่อแสดงรายการเซลล์ที่แก้ไขทั้งหมดในเนื้อหาอีเมล และเวิร์กบุ๊กจะถูกแทรกเป็นสิ่งที่แนบมาในอีเมลด้วย โปรดทำตามขั้นตอนต่อไปนี้:
1. เปิดแผ่นงานที่มีเซลล์ที่คุณต้องการส่งอีเมลโดยคลิกขวาที่แท็บแผ่นงานแล้วคลิก ดูรหัส จากเมนูคลิกขวา จากนั้นคัดลอกรหัสต่อไปนี้ลงในหน้าต่างแผ่นงาน (รหัส)
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 ให้ดับเบิลคลิก สมุดงานนี้ ในบานหน้าต่างด้านซ้าย จากนั้นคัดลอกโค้ด VBA ต่อไปนี้ไปที่ ThisWorkbook (รหัส) หน้าต่าง
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
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันต้องการความช่วยเหลือในการเรียกใช้อีเมลโดยมีการเปลี่ยนแปลงเล็กน้อย แทนที่จะใช้ค่าตัวเลขหรือป้อนข้อมูลลงในเซลล์ด้วยตนเอง เซลล์ในคอลัมน์ B จะเปลี่ยนเป็น 'Y' ที่ทริกเกอร์จากสูตรในเซลล์อื่นในแถวนั้น สูตรสำหรับคอลัมน์ B คือ =IF([@[Quantity in Stock]]>[@[Reorder Level]],"Y") แสดงว่าสินค้าคงคลังมีน้อยและจำเป็นต้องสั่งซื้อใหม่ ฉันต้องเรียกใช้อีเมลอัตโนมัติเมื่อค่าของเซลล์เปลี่ยนแปลงในคอลัมน์ B เป็น 'Y' ดังนั้นฉันจึงได้รับการแจ้งเตือนโดยอัตโนมัติผ่านอีเมลของสินค้าที่สต็อกเหลือน้อย ฉันได้ลองทุกอย่างที่คิดได้ในการแก้ไขรหัสที่ให้ไว้แล้ว แต่ดูเหมือนว่าจะไม่มีอะไรได้ผลสำหรับฉัน... โปรดช่วยด้วย!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี แคทรีน เอฟ
รหัส VBA ต่อไปนี้สามารถช่วยคุณแก้ปัญหาได้ กรุณาให้มันลอง ขอบคุณสำหรับความคิดเห็นของคุณ.
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
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีและขอขอบคุณสำหรับการกวดวิชานี้
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 modifie C2, C3 ou C4 เอกลักษณ์ Cela fonctionne ออสซี่ 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. ตัวอย่างที่ตราไว้ si je modifie C2 et C4 sans modifier C3
Est-ce que quelqu'un pourrait m'aider pour m'indiquer où se trouve mon erreur ?
Merci d'avance

Worksheet_Change ย่อยส่วนตัว (เป้าหมายเป็นช่วง ByVal)
'ปรับปรุงโดย Extendoffice 20220921
Dim xAddress เป็นสตริง
Dim xDRg, xRgSel, xRg เป็นช่วง

xAddress = "C2:C4"
ตั้งค่า xDRg = ช่วง (xAddress)
ตั้งค่า xRgSel = อินเตอร์เซก (เป้าหมาย xDRg)
เกิดข้อผิดพลาด GoTo Err1
ถ้าไม่ใช่ xRgSel ก็ไม่มีอะไรทั้งนั้น
ถ้า ThisWorkbook.gChangeRange = "" แล้ว
ThisWorkbook.gChangeRange = xRgSel.AddressLocal (เท็จ เท็จ xlA1 จริง เท็จ)
อื่น
ตั้งค่า xRg = ช่วง (ThisWorkbook.gChangeRange)
ตั้งค่า xRg = Application.Union(xRg, xRgSel)
ThisWorkbook.gChangeRange = xRg.AddressLocal (เท็จ เท็จ xlA1 จริง เท็จ)
End If
End If
ออกจาก Sub
ข้อผิดพลาด 1:
ThisWorkbook.gChangeRange = xRgSel.AddressLocal (เท็จ เท็จ xlA1 จริง เท็จ)
ย่อยสิ้นสุด


-----

ตัวเลือกที่ชัดเจน
gChangeRange สาธารณะเป็นสตริง
สมุดงานย่อยส่วนตัว_AfterSave(ByVal Success As Boolean)
'ปรับปรุงโดย Extendoffice 20220921
Dim xRgSel, xRg เป็นช่วง
Dim xOutApp เป็นวัตถุ
Dim xMailItem เป็นวัตถุ
Dim xMailBody เป็นสตริง
'เมื่อเกิดข้อผิดพลาด ดำเนินการต่อ ต่อไป
เกิดข้อผิดพลาด GoTo Err1
ตั้งค่า xRg = ช่วง (gChangeRange)
ถ้าไม่ใช่ xRg ก็ไม่มีอะไรทั้งนั้น
ตั้งค่า xOutApp = CreateObject("Outlook.Application")
ตั้งค่า xMailItem = xOutApp.CreateItem(0)
xMailBody = "Cher Jean-Marie, " & vbCrLf & vbCrLf & "Dans le fichier : " & ThisWorkbook.FullName & vbCrLf & "La plage de cellules a été modifiée :" & xRg.Address (False, False) & vbCrLf & "น้ำใจ"
ด้วย xMailItem
.ถึง = "x.xxxxxx@xxxx.fr"
.Subject = "ตัวดัดแปลงของ Données" & ThisWorkbook.Name
.Body = xMailBody
.Attachments.Add (ThisWorkbook.FullName)
.แสดง
จบด้วย
ตั้งค่า xRgSel = Nothing
ตั้งค่า xOutApp = Nothing
ตั้งค่า xMailItem = Nothing
End If
ข้อผิดพลาด 1:
gChangeRange = ""
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันต้องการส่งอีเมลถึง 5 คน แต่ละที่อยู่อีเมลใช้ตัวคั่นอะไร
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
โจ hi,
โปรดใช้เครื่องหมายอัฒภาคเพื่อแยกที่อยู่อีเมล
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
นี่เป็นคำถามอื่น หากเซลล์หนึ่งเปลี่ยนแปลง เซลล์นั้นจะส่งอีเมล หากเปลี่ยน 3 เซลล์ ระบบจะส่งอีเมล 3 ฉบับ คุณจะหยุดสิ่งนี้ได้อย่างไรจึงจะส่งอีเมลเพียง 1 ฉบับเมื่อการแก้ไขเสร็จสิ้น
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
โจ hi,
สมมติว่าคุณระบุช่วงเป็น "A2:E11" ในรหัส ฉันจะตรวจสอบได้อย่างไรว่าการแก้ไขทั้งหมดเสร็จสิ้นแล้ว?
มีความคิดเห็นยังไม่มีการโพสต์ที่นี่
แสดงความคิดเห็นของคุณ
โพสต์ในฐานะแขก
×
ให้คะแนนโพสต์นี้:
0   ตัวอักษร
สถานที่แนะนำ

ช่องทางอื่นๆ

ลิขสิทธิ์© 2009 - wwwextendoffice.com | สงวนลิขสิทธิ์. ขับเคลื่อนโดย ExtendOffice. | แผนผังเว็บไซต์
Microsoft และโลโก้ Office เป็นเครื่องหมายการค้าหรือเครื่องหมายการค้าจดทะเบียนของ Microsoft Corporation ในสหรัฐอเมริกาและ / หรือประเทศอื่น ๆ
ได้รับการปกป้องโดย Sectigo SSL