I think this will get you close:

Sub MarkPunct()
Application.ScreenUpdating = False
Dim oRng As Range
Set oRng = ActiveDocument.Range
With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Highlight = True 'Activate replacement highlighting
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
Options.DefaultHighlightColorIndex = wdPink
.Text = Chr(34) & "*" & Chr(34)
While .Execute
If oRng.Characters(2).Font.Bold = False Then oRng.Characters(1).HighlightColorIndex = wdPink
If oRng.Characters.Last.Previous.Font.Bold = False Then oRng.Characters.Last.HighlightColorIndex = wdPink
If oRng.Characters.First.Font.Bold = False And oRng.Characters(2).Font.Bold = True Then oRng.Characters.First.HighlightColorIndex = wdPink
If oRng.Characters.Last.Font.Bold = False And oRng.Characters.Last.Previous.Font.Bold = True Then oRng.Characters.Last.HighlightColorIndex = wdPink
Wend
End With
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "[" & Chr(145) & Chr(146) & Chr(147) & Chr(148) & "]"
.MatchWildcards = True
.Replacement.Highlight = True
.Font.Bold = False
.Execute Replace:=wdReplaceAll
End With
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "[" & Chr(44) & Chr(145) & Chr(146) & Chr(147) & Chr(148) & "\(\)\[\]\:\;\.\'\,]"
.MatchWildcards = True
.Replacement.Highlight = True
.Font.Bold = True
.Execute Replace:=wdReplaceAll
End With
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "[" & Chr(39) & Chr(146) & "]" 'Highlight bold curly quotes/apostrophes, brackets/square brackets, comma etc.
.MatchWildcards = True
.Font.Bold = True
While .Execute
If oRng.Characters.First.Previous.Font.Bold And oRng.Characters.Last.Next.Font.Bold Then
oRng.HighlightColorIndex = wdNoHighlight
End If
Wend
End With
End Sub

__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/