如何对 word.range 的部分应用格式？

Question

下面的代码启动 word 应用程序，应该将 MSWord 中的文本（包含在双星号中）转换为粗体版本。所以文本 "this is **important** 应该变成“这是 重要的 ”

代码

Sub test()

    Dim wordApp As Object
    Dim testDoc As Object
    Dim testString
    
    testString = "this is something **important** and **this** is not"
    
    'the code that initialized Word
    On Error Resume Next
    Set wordApp = GetObject(, "Word.Application")
    If wordApp Is Nothing Then
        Set wordApp = CreateObject("Word.Application")
    End If
    wordApp.Visible = True
    
    Set testDoc = wordApp.Documents.Add
    
    'parsing the range
    testDoc.Range.Text = testString
    parse testDoc.Range

End Sub

Private Sub parse(parseRange As Word.Range)
    Dim workRange As Word.Range
        
    'counter
    Dim i
    'position of opening asterics
    Dim pos
    'position of closing asterics
    Dim pos2
    'auxilary range
    Set workRange = parseRange.Duplicate
    
    i = 1
    'parse bold (**)
    'do while doulbe asterics can be found in string
    Do While InStr(i, parseRange.Text, "**") <> 0
        
        'define the position of opening and closing asterics
        pos = InStr(parseRange.Text, "**")
        pos2 = InStr(pos + 2, parseRange.Text, "**")
        
        'remove asterics
        parseRange.Text = Replace(parseRange.Text, "**", "", , 2)
        'setting the auxilary range to make it bold
        workRange.SetRange pos - 1, pos2 - 2
        workRange.Bold = True
    Loop
End Sub
'Result: only the word "this" is formatted.

据我了解，这个问题是粗体格式属于 workRange，因此当我更改 workRange 的开始和结束位置时，粗体格式会随之移动。如何修复代码以使其正常工作？

Answer 1

我认为您的解决方案过于复杂了。您要做的正是使用通配符查找和替换的目的。试试这个：

Sub test()

    Dim wordApp As Object
    Dim testDoc As Object
    Dim testString
    
    testString = "this is something **important** and **this** is not"
    
    'the code that initialized Word
    On Error Resume Next
    Set wordApp = GetObject(, "Word.Application")
    If wordApp Is Nothing Then
        Set wordApp = CreateObject("Word.Application")
    End If
    wordApp.Visible = True
    
    Set testDoc = wordApp.Documents.add
    
    'parsing the range
    testDoc.Range.text = testString
    FindReplaceWithWildcards testDoc, "(\*{2})(*)(\*{2})"

End Sub

Sub FindReplaceWithWildcards(docTarget As Document, findText As String)
   Dim findRange As Word.Range

   Set findRange = docTarget.Range

   With findRange.Find
      .ClearFormatting
      .text = findText
      .Forward = True
      .Wrap = wdFindStop
      .Format = True
      .MatchWildcards = True
      With .Replacement
         .ClearFormatting
         .text = ""
         .Font.Bold = True
      End With
      .Execute Replace:=wdReplaceAll
   End With
End Sub

如何对 word.range 的部分应用格式？

How do I apply formatting to the parts of word.range?

vba

ms-word