Question

我是Excel中的VB新手。我在Excel中制作了一个电子邮件提醒程序，其中一个单元格中的公式（计算）更改了值。问题是即使符合条件，电子邮件提醒也没有弹出。但是当我手动输入数字（满足条件）时，电子邮件提醒会弹出。如果计算中的单元格值满足程序条件，请帮助使程序运行。谢谢！这是代码：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim completed As Boolean
    Dim rowCount As Long
    Dim i As Integer
    Dim Objek As String
    Dim SatKer As String
    Dim Hari As String
    Dim AlamatEmail As String
    Dim xMailBody As String
    rowCount = 2
    If Target.Cells.Count > 1 Then Exit Sub
    For i = 1 To 5
        rowCount = rowCount + 1
        Set xRg = Range("O" & CStr(rowCount))
        Objek = ActiveSheet.Range("F" & CStr(rowCount)).Value
        SatKer = ActiveSheet.Range("G" & CStr(rowCount)).Value
        Hari = ActiveSheet.Range("O" & CStr(rowCount)).Value
        AlamatEmail = ActiveSheet.Range("S" & CStr(rowCount)).Value
        If xRg = Target And Target.Value < 4 Then
            Call Mail_small_Text_Outlook(Objek, SatKer, Hari, AlamatEmail)
        End If
    Next i
End Sub
Sub Mail_small_Text_Outlook(Objek As String, SatKer As String, Hari As String, AlamatEmail As String)
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Yth. Bapak Widi " & vbNewLine & vbNewLine & _
                "Laporan Penilaian " & Objek & " milik " & SatKer & " mendekati batas akhir pengumpulan." & vbNewLine & _
                "Laporan tersebut harus disubmit dalam " & Hari & " hari." & vbNewLine & vbNewLine & _
                "Mohon cek status laporan penilaian untuk keterangan laporan lebih detail."
    On Error Resume Next
    With xOutMail
        .To = AlamatEmail
        .cc = ""
        .BCC = ""
        .Subject = "Laporan Penilaian " & Objek & " milik " & SatKer
        .HTMLBody = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

Answer 1

以下应该按照您的预期进行，代码将遍历O列，如果计算的值小于4，那么它将显示。

Private Sub Worksheet_Calculate()
    Dim ws As Worksheet: Set ws = Sheets("Sheet1")
    'declare and set your worksheet, amend as required
    LastRow = ws.Cells(ws.Rows.Count, "O").End(xlUp).Row
    'get the last row with data on Column O
    Dim completed As Boolean
    Dim rowCount As Long
    Dim i As Integer
    Dim Objek As String
    Dim SatKer As String
    Dim Hari As String
    Dim AlamatEmail As String
    Dim xMailBody As String

    For i = 3 To LastRow 'loop from row 3 to last on Column O

        Set xRg = Range("O" & i)
        Objek = ws.Range("F" & i).Value
        SatKer = ws.Range("G" & i).Value
        Hari = ws.Range("O" & i).Value
        AlamatEmail = ws.Range("S" & i).Value

        If ws.Cells(i, "O").Value < 4 Then 'if value is less than 4 then send email
            Call Mail_small_Text_Outlook(Objek, SatKer, Hari, AlamatEmail)
        End If

    Next i
End Sub


Sub Mail_small_Text_Outlook(Objek As String, SatKer As String, Hari As String, AlamatEmail As String)
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Yth. Bapak Widi " & vbNewLine & vbNewLine & _
                "Laporan Penilaian " & Objek & " milik " & SatKer & " mendekati batas akhir pengumpulan." & vbNewLine & _
                "Laporan tersebut harus disubmit dalam " & Hari & " hari." & vbNewLine & vbNewLine & _
                "Mohon cek status laporan penilaian untuk keterangan laporan lebih detail."
    On Error Resume Next
    With xOutMail
        .To = AlamatEmail
        .cc = ""
        .BCC = ""
        .Subject = "Laporan Penilaian " & Objek & " milik " & SatKer
        .HTMLBody = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

电子邮件提醒未触发（发送）Excel中的公式值更改

1 个答案: