Question

我目前有以下代码，根据输入到电子表格中的数据发送电子邮件。

正如您所看到的，发送电子邮件的范围与在B1（+1）中输入的行号以及最多包括在B2中输入的行号有关。我想添加到这个代码，所以它也为行着色。我们有6个不同的电子邮件可以根据按钮点击发送，我们希望每个电子邮件发送的行颜色不同。

Sub SendEmail(what_address As String, subject_line As String, mail_body As String)

Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")

Dim olMail As Outlook.MailItem
Set olMail = olApp.CreateItem(olMailItem)

olMail.To = what_address
olMail.Subject = subject_line
olMail.BodyFormat = olFormatHTML
olMail.HTMLBody = mail_body
olMail.Send

End Sub

Sub Del24Hrs()

row_number = Sheet1.Range("B1")

Do
DoEvents
row_number = (row_number + 1)
Dim mail_body_message As String
Dim To_Name As String
Dim Order_No As String
Dim RN_No As String

mail_body_message = Sheet2.Range("A1")
subject_line = "Envirovent Order Confirmation"
To_Name = Sheet1.Range("D" & row_number)
Order_No = Sheet1.Range("G" & row_number)
RN_No = Sheet1.Range("A" & row_number)
mail_body_message = Replace(mail_body_message, "Replace_To_Name", To_Name)
mail_body_message = Replace(mail_body_message, "Replace_Order_No", Order_No)
mail_body_message = Replace(mail_body_message, "Replace_RN_No", RN_No)

Call SendEmail(Sheet1.Range("F" & row_number), "Envirovent Order Confirmation", mail_body_message)
Loop Until row_number = Sheet1.Range("B2")

End Sub

谢谢

Answer 1

假设用户按下按钮1，您想要显示红色。颜色为RGB（255,0,0）。插入一个形状作为按钮，右键单击并选择“指定宏”，然后分配子Button1Click。

这应绘制用于发送电子邮件的范围。您可以更改RGB数字以轻松获得不同的颜色。在Excel工作表中使用字体颜色（转到更多颜色）选择您的数字，然后为其他5个按钮创建类似的子颜色：

'将此代码分配给按钮1：

Sub Button1Click()
    Call Del24Hrs(RGB(255, 0, 0))
End Sub

用于发送电子邮件和为所用范围着色的代码：

Sub Del24Hrs(lColor As Long)
    Dim mail_body_message As String
    Dim To_Name As String
    Dim Order_No As String
    Dim RN_No As String
    Dim rng As Range

    row_number = Sheet1.Range("B1")

    Set rng = Sheet1.Range("A1")

    Do
        DoEvents
        row_number = (row_number + 1)

        mail_body_message = Sheet2.Range("A1")
        subject_line = "Envirovent Order Confirmation"
        To_Name = Sheet1.Range("D" & row_number)
        Order_No = Sheet1.Range("G" & row_number)
        RN_No = Sheet1.Range("A" & row_number)

        Set rng = AddRange(rng, To_Name)
        Set rng = AddRange(rng, Order_No)
        Set rng = AddRange(rng, RN_No)

        mail_body_message = Replace(mail_body_message, "Replace_To_Name", To_Name)
        mail_body_message = Replace(mail_body_message, "Replace_Order_No", Order_No)
        mail_body_message = Replace(mail_body_message, "Replace_RN_No", RN_No)

        Call SendEmail(Sheet1.Range("F" & row_number), "Envirovent Order Confirmation", mail_body_message)
    Loop Until row_number = Sheet1.Range("B2")

    'Color the range at once
    rng.Interior.Color = lColor

End Sub

发送电子邮件时使用的联合范围的代码：

Function AddRange(rng1 As Range, rng2 As Range) As Range
    Set AddRange = Application.Union(rng1, rng2)
End Function

VBA代码突出显示某个范围（除了电子邮件代码）

1 个答案: