VBA代码突出一定的范围(除了电子邮件代码)

我目前有下面的代码,根据input到电子表格中的数据发送电子邮件。

正如您所看到的,电子邮件的发送范围是在B1(+1)中input的行号,并且包括在B2中input的行号。 我想添加到这个代码,所以它也为行着色。 我们有6个不同的电子邮件,可以发送,这取决于button命中,我们希望该行是每个电子邮件发送不同的颜色。

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 

谢谢

比方说,如果用户按下button1,您想要显示红色。颜色是RGB(255,0,0)。 插入一个形状作为button,右键单击并select“分配macros”,然后分配子Button1Click。

这应该绘制用于发送电子邮件的范围。 您可以轻松改变RGB数字以获得不同的颜色。 使用Excel工作表中的字体颜色(转到更多颜色)来select您的数字,然后为其他5个button创build类似的子工具:

'将此代码分配给button1:

 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