首页 > 解决方案 > 当单元格的值为 16、64 或 120 时发送电子邮件

问题描述

我有一个代码,我的所有单元格都是有条件的,并且一个单元格(B6)的值会发生变化。

我希望每次 B6 单元格值为 16、64 和 120 时发送电子邮件。

目前它只会在 16 发送,并且一旦达到 16 目标,它将开始从任何单元发送。

Option Explicit

Private Sub Worksheet_Calculate()
    Dim FormulaRange As Range
    Dim NotSentMsg As String
    Dim MyMsg As String
    Dim SentMsg As String
    Dim MyLimit As Double


On Error GoTo errHandler:

Sheet2.Unprotect Password:="1234"

    NotSentMsg = "Not Sent"
    SentMsg = "Sent"

    'Above the MyLimit value it will run the macro
    MyLimit = 15

    'Set the range with the Formula that you want to check
    Set FormulaRange = Me.Range("B6")

    For Each FormulaCell In FormulaRange.Cells
        With FormulaCell
            If IsNumeric(.Value) = False Then
                MyMsg = "Not numeric"
            Else
                If .Value > MyLimit Then
                    MyMsg = SentMsg
                    If .Offset(0, 1).Value = NotSentMsg Then
                        Call Mail_Outlook_With_Signature_Html_1
                    End If
                Else
                    MyMsg = NotSentMsg
                End If
            End If
            Application.EnableEvents = False
            .Offset(0, 1).Value = MyMsg
            Application.EnableEvents = True
        End With
    Next FormulaCell

'ExitMacro:
 '   Exit Sub

'EndMacro:
    Application.EnableEvents = True
Sheet2.Protect Password:="1234"
 '   MsgBox "Some Error occurred." _
  '       & vbLf & Err.Number _
   '      & vbLf & Err.Description

On Error GoTo 0
    Exit Sub
errHandler:
    MsgBox "An Error has Occurred  " & vbCrLf & _
           "The error number is:  " & Err.Number & vbCrLf & _
           Err.Description & vbCrLf & "Please Contact Admin"

End Sub

标签: excelvba

解决方案


认为你只需要这个。如果 B6>15,您之前的代码将在每次重新计算后运行。(每次重新计算工作表时,此代码仍将运行,但仅在命中这些值时才会发送消息。)

只有在考虑一系列单元格时才需要循环,例如 B6:B10。

Private Sub Worksheet_Calculate()

Dim NotSentMsg As String
Dim MyMsg As String
Dim SentMsg As String

On Error GoTo errHandler:
Sheet2.Unprotect Password:="1234"

NotSentMsg = "Not Sent"
SentMsg = "Sent"

With Me.Range("B6")
    If Not IsNumeric(.Value) Then
        MyMsg = "Not numeric"
    Else
        If .Value = 16 Or .Value = 64 Or .Value = 120 Then
            MyMsg = SentMsg
            If .Offset(0, 1).Value = NotSentMsg Then
                Call Mail_Outlook_With_Signature_Html_1
            End If
        Else
            MyMsg = NotSentMsg
        End If
    End If
    Application.EnableEvents = False
    .Offset(0, 1).Value = MyMsg
    Application.EnableEvents = True
End With

Application.EnableEvents = True
Sheet2.Protect Password:="1234"
On Error GoTo 0
Exit Sub
errHandler:
MsgBox "An Error has Occurred  " & vbCrLf & _
       "The error number is:  " & Err.Number & vbCrLf & _
       Err.Description & vbCrLf & "Please Contact Admin"

End Sub

推荐阅读