【wordマクロ・word VBA】太字のルビを付ける

太字のルビを付けるword用マクロを作るのに、検索してもなかなかヒットしなかったのでメモしておきます。

マクロの内容：選択した文字の上に「＊」を付けます。
　　　　　　　「＊」は文字サイズ6ptの太字です。

ポイントは、「ルビに太字を反映するために、フィールドコード内の「* jc2」の部分を削除する」ことです。
この部分を消す＝中央揃え（jc0）も使えないため、文字位置の調整が必要なのが難点……

---

Sub 選択した文字に太字のルビを打つ()
  
    Dim selectRange As Range
    Set selectRange = Selection.Range
    
    Dim targetField As Field
    
    Dim codetextBF As String
    Dim codetextAF As String
    Dim codeArray  As Variant
    Dim cotetextCnt As Integer
    Dim iRubyCount As Integer
    Dim rubytext As String
    Dim i As Integer: i = 0
    Dim j As Integer
    Dim selectTxt As String
    Dim codeLen As Integer
        
    Dim startPosition As Integer
    Dim endPosition As Integer
        
    startPosition = selectRange.Start
    selectTxt = selectRange.Text
        
    '選択された文字の上側に「・」を打つ
    Selection.SetRange Start:=startPosition, End:=startPosition + 1
    For i = 0 To Len(selectTxt) - 1
        Selection.Range.PhoneticGuide Text:="・" & " ", Alignment:= _
            wdPhoneticGuideAlignmentOneTwoOne, Raise:=8, FontSize:=6
            
        Selection.Range.Characters.Last.Select
        For Each targetField In Selection.Fields
    
            'フィールドコード内の「\* jc2」の部分を削除しないと太字が反映されないので、ここで削除
            With targetField
                codetextBF = .Code.Text
                codeArray = Split(codetextBF, "\")
                codeArray(1) = ""
                codeArray(5) = "ar("
                codetextAF = ""
                codetextAF = codeArray(0) & codeArray(1) & "\"
                For j = 2 To UBound(codeArray)
                  codetextAF = codetextAF & codeArray(j) & "\"
                Next
                codetextAF = Left(codetextAF, Len(codetextAF) - 1)
                cotetextCnt = Len(codetextAF)
                .Code.Text = codetextAF
            End With
    
            'ルビの中の「、」を検索して太字＆文字サイズを6に変更
            With Selection.Find
                .Forward = True
                .Wrap = wdFindStop
                .Text = "・ "
                .Execute
            End With
            With Selection
                .Font.Bold = True
                .Font.Size = 6
            End With
    
        Next
        
        Call Selection.MoveRight(wdCharacter, 1, wdSelection)
        Selection.Characters.Last.Next.Select
            
    Next i
    
    Set selectRange = Selection.Range
    endPosition = selectRange.End - 1
    
    Selection.SetRange Start:=startPosition, End:=endPosition
                   
    Set selectRange = Nothing
    Set targetField = Nothing
     
End Sub