当单元格更改时触发电子邮件

首先，您尚未发布您正在使用的确切子，但假设它是Worksheet_Change，它不会因单元格格式更改而触发。相反，请使用Worksheet_SelectionChange。

如果您假设除了要提取的标题外，单元格将始终为空，则迭代直到到达非空单元格将起作用：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Interior.Color = RGB(255,255,0) Then 
' Set this to the exact color or flip the statement so it's:
' If Target.Interior.Color <> RGB(0,0,0) Then
    Dim r As Integer
    Dim c As Integer
    Dim staff As String
    Dim date As String
    r = 0
    c = 0
    While Target.Offset(r,0) <> ""
        r = r - 1
    Wend
    While Target.Offset(0,c) <> ""
        c = c - 1
    Wend
' These move through the row (and then the column) until a non empty cell is found
    staff = Target.Offset(0,c).Value
    date = Target.Offset(r,0).Value & Target.Offset(r-2,0).Value
' Get the string values; need to append the two day then date values
End If
End Sub
    

让我知道这是否有效。

编辑：在选择多个日期的情况下，每次更改颜色时都会触发 Change 事件。考虑一下，最好创建一个 FormControl 按钮并将宏链接到该按钮，这样您就不会在更改单元格颜色后立即发送电子邮件。

编辑2：这是修改后的问题中的更新代码。让我知道这是否有效。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

' Start with the conditional
If Target.Interior.Color = RGB(255,0,0) Then

Dim xDateSelected As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xMailBody As String

On Error Resume Next

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim r As Integer
Dim c As Integer
Dim staff As String
Dim date1 As String

r = 0
c = 0
While Target.Offset(r, 0) = ""
    r = r - 1
Wend
While Target.Offset(0, c) = ""
    c = c - 1
Wend
'These move through the row (and then the column) until a non empty cell is found

staff = Target.Offset(0, c).Value
date1 = Target.Offset(r, 0).Value & Target.Offset(r - 2, c).Value
'I use r-2, c here to get the date, assuming it is a merged cell which have weird behaviour
'Get the string values; need to append the two day then date values

Set xDateSelected = Range(date1).Value ' Keep in mind you must either reference the cell itself 
' or a variable storing a string with the cell reference

Set Mydate = Intersect(Target, xDateSelected)
ActiveWorkbook.Save

If Not Mydate Is Nothing Then
    Set xOutApp = CreateObject("Outlook.Application")
    Set xMailItem = xOutApp.CreateItem(0)
'code to retrieve content from affected cells and putting into email content ie "staff name" is applying for leave on "date"

    xMailBody = "Hi there Priscilla" & vbNewLine & vbNewLine & _
    "Name: " & staff & " is applying for Ad-hoc leave on " & date1 & vbNewLine & vbNewLine & _
    "Reason: " & vbNewLine & vbNewLine & _
    "Thank you" & vbNewLine 'calling out and placing values of each col into email body


    With xMailItem
        .To = "[email protected]"
        .Subject = "Applying for Ad-hoc leave "
        .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 If
End Sub