格式化 VBA 中文本字符串的特定部分

Formatting specific part of text string in VBA

我正在创建一个宏,用于保存当前工作簿、创建新的 Outlook 邮件并将文件附加到邮件中。我的宏可以做到这一点,但我无法根据自己的喜好格式化电子邮件正文中的文本。

Dim OutApp As Object
Dim OutMail As Object
Dim sBody, Customer As String

ActiveWorkbook.Save


sBody = "All," & Chr(10) & Chr(10) & "Please Approve attached Request below for " & rType & "." _
 & Chr(10) & Chr(10) & "Customer: " & customer & Chr(10)

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

On Error Resume Next
    With OutMail
        .to = recip
        .CC = CCed
        .BCC = ""
        .subject = subject
        .Body = sBody
        .Attachments.Add ActiveWorkbook.FullName
        .display

       End With
    On Error GoTo 0

End Sub  

我希望在电子邮件中显示以下消息(带格式)。

All,

Please Approve attached Request below for "rtype".

Customer: Whosebug

所以,"customer"这个词需要加粗。我已经厌倦了多种解决方案,但它们不起作用,因为这是在创建 outlook 邮件对象。

任何帮助将不胜感激。

**

Solution: To make the HTML tags work change the body type to html by ".HTMLBody". and you will be able to use HTML Tags. Kudos to Dick Kusleika

**

你有几个选择

1) 使用 HTML 就像一些人评论的那样

2) 将该文本放在隐藏的 sheet 上并根据需要对其进行格式化,然后将其作为范围引用到正文中,例如.Body = sheets("hidden_Body").range("A1:B10")

3) 你可以尝试使用类似下面的东西(请注意下面用于将一个 wingding 字符添加到字符串中,需要修改以适合你的目的)

Sub Build_Wingdings(Sh As Worksheet, rng As Range)

Dim cur_L As Integer
cur_L = 1
Sheets("Word_Specifications").Range("BZ9").Copy
Sh.Range(rng.Address).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Application.CutCopyMode = False

With Sheets("Word_Specifications")
    .Select
    For Each cell In .Range(.Range("Word_Standard_Start").Address, .Range("Word_Standard_Start").End(xlDown).Address)
        If cell.value = "" Then
        Else
            L = Len(cell.value) + 1
            With Sh.Range(rng.Address)
                With .Characters(start:=cur_L, Length:=L).Font
                    .Name = "Arial"
                    .FontStyle = "Regular"
                    .Size = 9
                    .Bold = False
                    .Strikethrough = False
                    .Superscript = False
                    .Subscript = False
                    .OutlineFont = False
                    .Shadow = False
                    .Underline = xlUnderlineStyleNone
                    .ThemeColor = xlThemeColorLight1
                    .TintAndShade = 0
                    .ThemeFont = xlThemeFontNone
                End With

                cur_L = cur_L + L

                If .value <> "" Then
                    add_Wingdings cur_L, 1, Sh, rng
                    cur_L = cur_L + 2
                End If
            End With
        End If
    Next
End With


End Sub

Sub add_Wingdings(start As Integer, Length As Integer, Sh As Worksheet, rng As Range)
With Sh.Range(rng.Address).Characters(start:=start, Length:=Length).Font
    .Name = "Wingdings 3"
    .FontStyle = "Regular"
    .Size = 9
    .Bold = False
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
    .ThemeFont = xlThemeFontNone
End With
End Sub

HTML 标签确实有效。我不知道你为什么说他们没有。

sBody = "All,<br /><br />Please Approve attached request for " & rType & ".<br /><br /><strong>Customer:</strong> " & customer & "<br />"

然后使用 .HTMLBody

而不是 .Body 属性
.HTMLBody = sBody