CODEWITHSUNDEEP
vbams-word
Igor Cheglakov
Igor Cheglakov

Reputation: 555

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

The code below starts word application and should turn the text in MSWord, enclosed into double asterics into it's bold version. So the text "this is **important** should become "this is important"

The code

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.

The problem with this as I understand is that bold formatting belongs to the workRange, so when I change the starting and ending position of workRange, the bold formatting moves with it. How do I fix the code to work properly?

Upvotes: 0

Views: 95

Answers (1)

Timothy Rylatt
Timothy Rylatt

Reputation: 7850

I think you're over complicating your solution. What you are looking to do is precisely what Find and Replace with wildcards is designed to do. Try this:

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 = "\2"
         .Font.Bold = True
      End With
      .Execute Replace:=wdReplaceAll
   End With
End Sub

Upvotes: 1

Related Questions