Question

我有代码，如果列I，它将查看该值，然后发送电子邮件，如果它符合我的任何限制。然后我在编辑另一列时也包括刷新。

此代码位于ThisWorkbook

中

Private Sub Workbook_Open()
    Call Worksheet_Calculated
End Sub

这是我在Sheet1中的代码，如果G列中的任何内容发生变化，它将运行该操作。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address Like "$F$*" Then
        Call Worksheet_Calculated
    End If
End Sub

此代码位于模块中。它会检查第I列中的任何值是否为MyLimit值中的任何值，如果是，则在第I列中，它将表示已发送或未发送。如果已发送，将生成一封电子邮件。

Option Explicit

Public Sub Worksheet_Calculated()

    Dim FormulaRange As Range
    Dim NotSentMsg As String
    Dim MyMsg As String
    Dim SentMsg As String
    Dim MyLimita As Double
    Dim MyLimitb As Double
    Dim MyLimitc As Double
    Dim MyLimitd As Double

    NotSentMsg = "Not Sent"
    SentMsg = "Sent"

    'Above the MyLimit value it will run the macro
    MyLimita = 100
    MyLimitb = 50
    MyLimitc = 10
    MyLimitd = 1

    'Set the range with Formulas that you want to check
    'This is the column that shows how many days left

    Set FormulaRange = Range("H5:H25")

    On Error GoTo EndMacro:
    For Each FormulaCell In FormulaRange.Cells
        With FormulaCell
            If IsNumeric(.Value) = False Then
                MyMsg = ""
            ElseIf (.Value = MyLimita Or .Value = MyLimitb Or .Value = MyLimitc Or .Value = MyLimitd) Then
                    MyMsg = SentMsg
                    If .Offset(0, 1).Value = NotSentMsg Then
                        Call Mail_with_outlook(FormulaCell)
                    End If
            Else
                MyMsg = NotSentMsg
            End If
            Application.EnableEvents = False
            .Offset(0, 1).Value = MyMsg
            Application.EnableEvents = True
        End With
    Next FormulaCell

ExitMacro:
    Exit Sub

EndMacro:
    Application.EnableEvents = True

    MsgBox "Some Error occurred." _
         & vbLf & Err.Number _
         & vbLf & Err.Description

End Sub

以上代码将调用另一个模块，该模块将填充我要发送的电子邮件。

Option Explicit

Public FormulaCell As Range

Public Sub Mail_with_outlook(FormulaCell As Range)
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strto As String, strcc As String, strbcc As String
    Dim strsub As String, strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

'Change the parenthesis for column that the email is in

    strto = Cells(FormulaCell.Row, "K").Value
    strcc = ""
    strbcc = ""
    strsub = "Payment Notification (PO --Enter PO # Here--)"

'Change the parenthesis for the Column that the POC is in

    strbody = "Hi " & Cells(FormulaCell.Row, "J").Value & vbNewLine & vbNewLine & _
              "This is a reminder to pay for a licensing/maintenance bill in: " & Cells(FormulaCell.Row, "H").Value & " days." & _
              vbNewLine & vbNewLine & "Line 2" & _
              vbNewLine & "Line 3" & _
              vbNewLine & "Line 4" & _
              vbNewLine & "Line 5" & _
              vbNewLine & "Line 6"

    With OutMail
        .To = strto
        .CC = strcc
        .BCC = strbcc
        .Subject = strsub
        .Body = strbody
        'You can add a file to the mail like this
        '.Attachments.Add ("C:\test.txt")
        .Display    ' or use .Send
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

我希望在启动时以及每次编辑列G时继续运行此代码，但仅限于Sheet1。

我想在第I列为负时将整行复制到sheet2。

当单元格值为负时，将行从一个工作表复制到另一个工作表

0 个答案: