Vba 粗体和下划线只是字符串的一部分

所以。。。我有一个表单，人们从列表框中选择不同的控件（我们称之为安全措施控件，这些不是内容控件），然后将它们添加到列表中。这是在重复表中。每个控件都有一个标题标签（“工程”、“管理”或“PPE”），我希望将其加粗并加下划线，但我希望在列表框中选择的选项采用正常格式。 将其打印到文档的代码部分如下所示：

  
    Set tableSequence = ActiveDocument.Tables(1)
    Set NewRow = tableSequence.Rows.Add
 
NewRow.Cells(5).Range.Text = "Engineering: " & MyString3 _
        & vbCrLf & "Administrative: " _
        & MyString4 & vbCrLf _
        & "PPE: " & MyString5

我希望Engineering、Administrative和PPE这几个词用粗体加下划线，MyString对象所代表的项目用标准格式显示。谢谢

字符串部分如下所示：

Private Sub CommandButton6_Click()
    Dim tableSequence As Table
    Dim NewRow As Row
    Dim MyString5 As String
    Dim v As Variant
    Dim var3
    Dim p As String
    Dim M As Long
    
    For var3 = 0 To ListBox7.ListCount - 1
    If ListBox7.Selected(var3) = True Then
    MyString5 = MyString5 & ListBox7.List(var3)
    v = Split(MyString5, ",")
    p = ""
    For M = LBound(v) To UBound(v)
    p = p + v(M)
    If M Mod 3 = 2 Then
    p = p + vbCr
    Else
    p = p + ","
    End If
Next M
p = Left(p, Len(p) - 1)
Debug.Print p
End If

---

很抱歉省略了这一点

如何在Word表格中格式化单元格值的一部分（或多部分）：

我必须承认我不太喜欢VBA这个词，但是我为你把这个子拼接在一起，它在我的测试文档中工作。根据你的需要调整它

Option Explicit
Sub asd()
Dim tableSequence As Table
Set tableSequence = ActiveDocument.Tables(1)
Dim NewRow As Row
Set NewRow = tableSequence.Rows.Add

NewRow.Cells(5).Range.Text = "Engineering: asd" & vbCrLf & "Administrative: vvv" & vbCrLf & "test" & vbCrLf & "PPE: blabla"
NewRow.Cells(5).Range.Bold = False
NewRow.Cells(5).Range.Underline = False

Dim keywordArr As Variant
keywordArr = Array("Engineering:", "Administrative:", "PPE:")

Dim keyword As Variant
Dim myRange As Variant
Dim startPos As Integer
Dim endPos As Integer
Dim length As Integer
Dim i As Integer
i = 1

For Each keyword In keywordArr

    Do While InStr(1, myRange, keyword) = 0
        Set myRange = NewRow.Cells(5).Range.Paragraphs(i).Range
        i = i + 1
    Loop
    startPos = InStr(1, myRange, keyword)
    startPos = myRange.Characters(startPos).Start
    length = Len(keyword)
    endPos = startPos + length
    
    Set myRange = ActiveDocument.Range(startPos, endPos)
    With myRange.Font
        .Bold = True
        .Underline = True
    End With
Next keyword

End Sub

下面是Excel中相同内容的解决方案：

首先，你必须像以前一样将文本写入单元格

下一步是查找关键字在单元格值中的位置+关键字的长度，如下所示

startPos = Instr(1, NewRow.Cells(5), "Engineering:")
length = len("Engineering:")

然后，您可以通过

Range.Characters.Font

NewRow.Cells(5).Characters(startPos, Length).Font.Bold = True
NewRow.Cells(5).Characters(startPos, Length).Font.Underline = True

现在，一种优雅的方法是拥有一个关键字数组，并对其进行迭代以更改所有关键字的字体

Dim keywordArr As Variant
keywordArr = Array("Engineering:", "Administrative:", "PPE:")

Dim keyword As Variant
Dim startPos as Integer
Dim length as Integer

For Each keyword In keywordArr
    startPos = InStr(1, NewRow.Cells(5), keyword)
    length = Len(keyword)

    With NewRow.Cells(5).Characters(startPos, Length).Font
        .Bold = True
        .Underline = True
    End With
Next keyword

---

代码中的MyString对象在哪里？我喜欢这个优雅的解决方案，但我最终发现一个错误，即每个关键字的

中的关键字
都是未定义的变量，这很可能是因为模块中有Option Explicit语句，它强制显式声明每个变量（这是完全正确的，甚至是值得鼓励的！）。我更新了答案以包含关键字声明。我可以将StartPos对象标注为整数吗？@Michael Miller是的！这非常有效，而且您的答案还帮助我理解了我在编码过程中遇到的一个关键问题。非常感谢！