VBA - ExcelからWord文書を作成し、太字のテキストを含む特定の行を編集する

Question

Excelのスプレッドシートからの入力を受け取る単語文書のすべての2行目のエントリを太字にすることを検討しています。言い換えれば、結果の単語文書に、太字のテキストを含めるために '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

名：ジョンスノー

グループ：グループB

ID：789101

名：サムウェルTarly

Answer 1

は、私の周りの仕事を見つけることができました。私は他人を助けるためにここに掲示すると思った。申し訳ありませんが、私のコードは、私が望むほどクリーンではありません。コピーと貼り付けはあまり一致しませんでした。

i = 2 
    Set objParagraph = wDoc.Paragraphs(i).Range 
    With objParagraph 
     .Font.Bold = True 
    End With 

と段落の差は、各反復

i = i + 4 'paragraph number 

後に追加されます。

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 
    intParaCount = wDoc.Paragraphs.Count 

      i = 2 
     Set objParagraph = wDoc.Paragraphs(i).Range 
     With objParagraph 
      .Font.Bold = True 
     End With 

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

     i = i + 4 'paragraph number 

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 

      i = i + 4 

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 

コードは、「私は」あなたは太字にしたい段落です.paragraphsを（）を利用します