Sub MarkParenthesizedItalicsNoProofing()
  Dim aRng As Range, aSubRng As Range
  Set aRng = ActiveDocument.Range
  With aRng.Find
    .ClearFormatting
    .Text = "\([A-Z][a-z.]@[!\)]@\)"
    .MatchWildcards = True
    .Forward = True
    .Wrap = False
    Do While .Execute
      Set aSubRng = ActiveDocument.Range(aRng.Start + 1, aRng.End - 1)
      aRng.NoProofing = aSubRng.Italic = True
      aRng.Collapse wdCollapseEnd
    Loop
  End With
End Sub