VBA - 从Excel创建Word文档并编辑某些行以包含粗体文本

Question

我希望在word文档上加粗每个第二行条目，该文档从excel电子表格接收输入。换句话说，我希望生成的word文档包含'ID：'的每一行包含粗体文本。我已经查看了其他示例，但我不断收到诸如不匹配等错误。

Sub ExceltoWord_TestEnvironment()
    Dim wApp As Object
    Dim wDoc As Object
    Dim strSearchTerm
    Dim FirstMatch As Range
    Dim FirstAddress
    Dim intMyVal As String
    Dim lngLastRow As Long
    Dim strRowNoList As String
    Dim intPlaceHolder As Integer

Set wApp = CreateObject("Word.Application")
Set wDoc = CreateObject("Word.Document")
wApp.Visible = True

Set wDoc = wApp.Documents.Add

wDoc.Range.ParagraphFormat.SpaceBefore = 0
wDoc.Range.ParagraphFormat.SpaceAfter = 0

strSearchTerm = InputBox("Please enter the date to find", "Search criteria")


If strSearchTerm <> "" Then
    Set FirstMatch = ActiveSheet.Cells.Find(strSearchTerm, LookAt:=xlPart, MatchCase:=False)

        If FirstMatch Is Nothing Then
            MsgBox "That date could not be found"
        Else

            FirstAddress = FirstMatch.Address
            intMyVal = strSearchTerm
            lngLastRow = Cells(Rows.Count, "F").End(xlUp).Row 'Search Column F, change as required.

        For Each cell In Range("F1:F" & lngLastRow) 'F is column
            If InStr(1, cell.Value, intMyVal) Then
                If strRowNoList = "" Then

                    strRowNoList = strRowNoList & cell.Row
                    intPlaceHolder = cell.Row

        wDoc.Content.InsertAfter "Group:             " & Cells(intPlaceHolder, 3) & vbNewLine
        wDoc.Content.InsertAfter "ID:         " & Cells(intPlaceHolder, 2) & vbNewLine
        wDoc.Content.InsertAfter "Name:              " & vbNewLine & vbNewLine
Else

                strRowNoList = strRowNoList & ", " & cell.Row
                intPlaceHolder = cell.Row

        wDoc.Content.InsertAfter "Group:             " & Cells(intPlaceHolder, 3) & vbNewLine
        wDoc.Content.InsertAfter "ID:         " & Cells(intPlaceHolder, 2) & vbNewLine
        wDoc.Content.InsertAfter "Name:              " & vbNewLine & vbNewLine

End If
            Next cell
            MsgBox strRowNoList

While Not FirstMatch Is Nothing
            Set FirstMatch = ActiveSheet.Cells.FindNext(FirstMatch)
        If FirstMatch.Address = FirstAddress Then
            Set FirstMatch = Nothing


        End If
        Wend
    End If

End If

End Sub

示例：

组：A组

ID：123456

姓名：Jon Snow

组：B组

ID：789101

姓名：Samwell Tarly