add words where is bold formating

[dagerr]

Hi, a following macro add desired words before and after part of paragraph when it contains bold formating, the problem is that it add that words even if paragraph is empty or it is one accidental sign. Could You help me with that?


Sub add_bold()

Dim x As Long, i As Long, ArrFnd()
ArrFnd = Array("")
For x = 0 To UBound(ArrFnd)
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Font.bold = True
.Font.Color = RGB(33, 33, 32)
.ParagraphFormat.Alignment = wdAlignParagraphJustify
.Execute
End With
Do While .Find.Found
.InsertAfter "{/body:bold}"
.InsertBefore "{body:bold}"
.End = .End
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Next
End Sub

[gmayor]

Based on your code and with some sample text in the array, the following will work


Sub add_bold()Dim orng As Range
Dim x As Long, i As Long, ArrFnd()
ArrFnd = Array("dolor", "nostrud", "blandit")
For x = 0 To UBound(ArrFnd)
Set orng = ActiveDocument.Range
With orng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Text = ArrFnd(x)
.Font.Bold = True
.Font.Color = RGB(33, 33, 32)
.ParagraphFormat.Alignment = wdAlignParagraphJustify
Do While .Execute
orng.Text = "{body:bold}" & orng.Text & "{/body:bold}"
orng.Collapse wdCollapseEnd
Loop
End With
Next
End Sub
However if you just want to tag bold text


Sub add_bold2()Dim orng As Range
Set orng = ActiveDocument.Range
With orng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Font.Bold = True
Do While .Execute
orng.Text = "{body:bold}" & orng.Text & "{/body:bold}"
orng.Collapse wdCollapseEnd
Loop
End With
End Sub

[dagerr]

Many thanks, but it still add tags to empty bold paragraphs, or to bolded paragraph signs at the end of paragraphs. Anyway I've solved that by adding if/then loop with lenght condition:


Sub add_bold2()
Dim orng As Range
Set orng = ActiveDocument.Range
With orng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Font.bold = True
.Font.Color = RGB(33, 33, 32)
Do While .Execute
If Len(orng) > 3 Then
orng.Text = "{body:bold}" & orng.Text & "{/body:bold}"
orng.Collapse wdCollapseEnd
End If
Loop
End With
End Sub