Thursday, September 8, 2011

Replace a list of words from an array

The following example uses a pair of arrays to hold corresponding lists of words, characters or phrases separated by commas. Items from the first list are replaced with the corresponding item from the second list
vFindText = Array(Chr(147), Chr(148), Chr(145), Chr(146))
vReplText = Array(Chr(34), Chr(34), Chr(39), Chr(39))
In a practical use of the technique, the above example as shown in the macro below, is used to replace smart quotes with straight quotes (and vice versa), however the list and macro could be modified to be used to replace or process any sequence of words or phrases

Sub ReplaceQuotes()
Dim vFindText As Variant
Dim vReplText As Variant
Dim sFormat As Boolean
Dim sQuotes As String
Dim
i As Long
'Ask the user whether to format with smart or straight quotes
sQuotes = MsgBox("Click 'Yes' to convert smart quotes to straight quotes." & vbCr & _
"Click 'No' to convert straight quotes to smart quotes.", _
vbYesNo, "Convert quotes")
'Record the current setting of the autoformat option to replace straight quotes with smart quotes
sFormat = Options.AutoFormatAsYouTypeReplaceQuotes

If sQuotes = vbYes Then 'The user has clicked 'Yes'
     'Define the lists of smart quotes and their replacements
     vFindText = Array(Chr(147), Chr(148), Chr(145), Chr(146))
     vReplText = Array(Chr(34), Chr(34), Chr(39), Chr(39))
     'Set the autoformat option to replace straight quotes with smart quotes to off
     Options.AutoFormatAsYouTypeReplaceQuotes = False
     'Start from the top of the document
     Selection.HomeKey wdStory
     With Selection.Find
          .Forward = True
          .Wrap = wdFindContinue
          .MatchWholeWord = True
          .MatchWildcards = False
          .MatchSoundsLike = False
          .MatchAllWordForms = False
          .Format = True
          .MatchCase = True
          'replace each item from the first array with the corresponding item in the second array
          For i = LBound(vFindText) To UBound(vFindText)
               .Text = vFindText(i)
               .Replacement.Text = vReplText(i)
               .Execute Replace:=wdReplaceAll
          Next i
     End With
Else
'User clicked 'No'
     'Use autoformat to replace straight quotes with smart quotes
     Options.AutoFormatReplaceQuotes = True
     Selection.Range.AutoFormat
End If
'Finally reset the autoformat setting to its start configuration
Options.AutoFormatAsYouTypeReplaceQuotes = sFormat
End Sub

No comments:

Post a Comment