Const NUMBER_OF_ACRONYMS As Integer = 2
Private Type Acronyms
acronym As Variant
definition As Variant
End Type
Private aList() As Acronyms
Private a() As String
Sub InitializeAcronymCollection()
ReDim aList(NUMBER_OF_ACRONYMS)
aList(0).acronym = "USA"
aList(0).definition = "United States of America"
aList(1).acronym = "SAT"
aList(1).definition = "Standard Aptitude Test"
End Sub
Sub ReplaceAcronyms()
InitializeAcronymCollection
Dim i As Integer
Dim aPos As Integer, aDefinitionPos As Integer
For i = 0 To UBound(aList) - 1
aDefinitionPos = PositionOfSearchString(aList(i).definition)
aPos = PositionOfSearchString(aList(i).acronym)
If aDefinitionPos < 0 Then
Call ReplaceAcronymWithDefinition(aList(i).acronym, aList(i).definition)
Else
If aPos < aDefinitionPos Then Call ReplaceAcronymWithDefinition(aList(i).acronym, aList(i).definition)
End If
Next i
End Sub
Function PositionOfSearchString(s As Variant) As Integer
Selection.HomeKey Unit:=wdStory
With Selection.Find
.Text = s
End With
If Selection.Find.Execute = True Then
PositionOfSearchString = Selection.Start
Else
PositionOfSearchString = -1
End If
End Function
Sub ReplaceAcronymWithDefinition(acr As Variant, definition As Variant)
Selection.HomeKey Unit:=wdStory
With Selection.Find
.Text = acr
.Replacement.Text = definition & " (" & acr & ")"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
With Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceOne
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseEnd
Else
.Collapse Direction:=wdCollapseStart
End If
.Find.Execute
End With
End Sub