modify ListAcronyms macro (for definitions before acronyms)

[Julia Jamison]

This macro (http://word.tips.net) works quite well if the acronym is displayed before the definition: ACRONYM (Definition). I work with documents that define the acronym first: Definition (ACRONYM). How should the macro be modified for the definition then acronym in parenthesis? I appreciate your help.

Sub ListAcronyms()
Dim strAcronym As String
Dim strDefine As String
Dim strOutput As String
Dim newDoc As Document

Application.ScreenUpdating = False
Selection.HomeKey Unit:=wdStory
ActiveWindow.View.ShowHiddenText = False

'Loop to find all acronyms
Do
'Search for acronyms using wildcards
Selection.Find.ClearFormatting
With Selection.Find
.ClearFormatting
.Text = "<[A-Z]@[A-Z]>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = True
.MatchWildcards = True
.MatchWholeWord = True
.Execute
End With

'Only process if something found
If Selection.Find.Found Then
'Make a string from the selection, add it to the
'output string
strAcronym = Selection.Text

'Look for definition
Selection.MoveRight Unit:=wdWord
Selection.MoveRight Unit:=wdCharacter, _
Extend:=wdExtend
strDefine = ""
If Selection.Text = "(" Then
While Selection <> ")"
strDefine = strDefine & Selection.Text
Selection.Collapse Direction:=wdCollapseEnd
Selection.MoveRight Unit:=wdCharacter, _
Extend:=wdExtend
Wend
End If
Selection.Collapse Direction:=wdCollapseEnd
If Left(strDefine, 1) = "(" Then
strDefine = Mid(strDefine, 2, Len(strDefine))
End If
If strDefine > "" Then
'Check if the search result is in the Output string
'if it is, ignore the search result
If InStr(strOutput, strAcronym) = 0 Then
strOutput = strOutput & strAcronym _
& vbTab & strDefine & vbCr
End If
End If
End If
Loop Until Not Selection.Find.Found

'Create new document and change active document
Set newDoc = Documents.Add

'Insert the text
Selection.TypeText Text:=strOutput

'Sort it
newDoc.Content.Sort SortOrder:=wdSortOrderAscending
Application.ScreenUpdating = True
Selection.HomeKey Unit:=wdStory
End Sub


EggHeadCafe - Software Developer Portal of Choice
WCF Workflow Services Using External Data Exchange
http://www.eggheadcafe.com/tutorial...a-6dafb17b6d74/wcf-workflow-services-usi.aspx

 

[Greg Maxey]

Julia,

Unless you have something to flag the start and end of the definition
associated with each acronym then I don't see any way that the macro could
be modified.

In your case the macro will be looking for something preceeding the leading
"(" which could be the flag for the definition end point but unless each
definition starts a new parargraph, or sentence, or is flagged in some
manner then it can't be determined where the definition starts.

This macro (http://word.tips.net) works quite well if the acronym is
displayed before the definition: ACRONYM (Definition). I work with
documents that define the acronym first: Definition (ACRONYM). How
should the macro be modified for the definition then acronym in
parenthesis? I appreciate your help.

Sub ListAcronyms()
Dim strAcronym As String
Dim strDefine As String
Dim strOutput As String
Dim newDoc As Document

Application.ScreenUpdating = False
Selection.HomeKey Unit:=wdStory
ActiveWindow.View.ShowHiddenText = False

'Loop to find all acronyms
Do
'Search for acronyms using wildcards
Selection.Find.ClearFormatting
With Selection.Find
.ClearFormatting
.Text = "<[A-Z]@[A-Z]>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = True
.MatchWildcards = True
.MatchWholeWord = True
.Execute
End With

'Only process if something found
If Selection.Find.Found Then
'Make a string from the selection, add it to the
'output string
strAcronym = Selection.Text

'Look for definition
Selection.MoveRight Unit:=wdWord
Selection.MoveRight Unit:=wdCharacter, _
Extend:=wdExtend
strDefine = ""
If Selection.Text = "(" Then
While Selection <> ")"
strDefine = strDefine & Selection.Text
Selection.Collapse Direction:=wdCollapseEnd
Selection.MoveRight Unit:=wdCharacter, _
Extend:=wdExtend
Wend
End If
Selection.Collapse Direction:=wdCollapseEnd
If Left(strDefine, 1) = "(" Then
strDefine = Mid(strDefine, 2, Len(strDefine))
End If
If strDefine > "" Then
'Check if the search result is in the Output string
'if it is, ignore the search result
If InStr(strOutput, strAcronym) = 0 Then
strOutput = strOutput & strAcronym _
& vbTab & strDefine & vbCr
End If
End If
End If
Loop Until Not Selection.Find.Found

'Create new document and change active document
Set newDoc = Documents.Add

'Insert the text
Selection.TypeText Text:=strOutput

'Sort it
newDoc.Content.Sort SortOrder:=wdSortOrderAscending
Application.ScreenUpdating = True
Selection.HomeKey Unit:=wdStory
End Sub


EggHeadCafe - Software Developer Portal of Choice
WCF Workflow Services Using External Data Exchange
http://www.eggheadcafe.com/tutorial...a-6dafb17b6d74/wcf-workflow-services-usi.aspx

--
Greg Maxey

See my web site http://gregmaxey.mvps.org
for an eclectic collection of Word Tips.

"It is not the critic who counts, not the man who points out how the
strong man stumbles, or where the doer of deeds could have done them
better. The credit belongs to the man in the arena, whose face is
marred by dust and sweat and blood, who strives valiantly...who knows
the great enthusiasms, the great devotions, who spends himself in a
worthy cause, who at the best knows in the end the triumph of high
achievement, and who at the worst, if he fails, at least fails while
daring greatly, so that his place shall never be with those cold and
timid souls who have never known neither victory nor defeat." - TR