Thanks for making this macro public. I was looking for one that has this
type of functionality. But, I was hoping it would create the glossary in the
beginning of the document and to also create infotips for each instance of an
acronym's usage, such that, in the body of the document, the infotip pops up
with the definition from the glossary. [I suppose you could extend this idea
to centralize the glossary in one (or more) external documents by having the
macro prompt for the path to the external doc prior to performing its
function or leveraging a reference at the beginning of the document, to the
external glossary document. ]

I could not figure out how to create infotips easily (I am currently using
Office 2003. Does Office 2007 address this functional concern?).

"Lene Fredborg" wrote:

> Below you will find a macro that extracts all words consisting of three or
> more uppercase letters to a new document. I have added comments in the code
> that explains what is going on. You may want to add more code to adjust the
> layout of the table into which the acronyms are inserted. I just made the
> macro and tested it on a small test document and it seems to work correctly –
> however, you may want to adjust what it does.
>
>
> Sub ExtractAcronymsToNewDocument()
>
> 'Finds all words consisting of 3 or more uppercase letters
> 'in active document document and inserts the words
> 'in column 1 of a 3-column table in a new document
> 'Each acronym is added only once
> 'Room for definition in column 2
> 'Page number of first occurrence is added in column 3
>
> Dim oDoc_Source As Document
> Dim oDoc_Target As Document
> Dim strListSep As String
> Dim strAcronym As String
> Dim oTable As Table
> Dim oRange As Range
> Dim n As Long
> Dim strAllFound As String 'use to keep track of foudnd
>
> 'Find the list separator from international settings
> 'In some countries it is comma, in other semicolon
> strListSep = Application.International(wdListSeparator)
>
> strAllFound = "#"
>
> Set oDoc_Source = ActiveDocument
> 'Create new document for acronyms
> Set oDoc_Target = Documents.Add
>
> With oDoc_Target
> 'Make sure document is empty
> .Range = ""
>
> 'Insert a table with room for acronym and definition
> Set oTable = .Tables.Add(Range:=.Range, NumRows:=2, NumColumns:=3)
> With oTable
> 'Format the table a bit
> 'Insert headings
> .Cell(1, 1).Range.Text = "Acronym"
> .Cell(1, 2).Range.Text = "Definition"
> .Cell(1, 3).Range.Text = "Page"
> 'Set row as heading row
> .Rows(1).HeadingFormat = True
> .Rows(1).Range.Font.Bold = True
> .PreferredWidthType = wdPreferredWidthPercent
> .Columns(1).PreferredWidth = 20
> .Columns(2).PreferredWidth = 70
> .Columns(3).PreferredWidth = 10
> End With
> End With
>
> With oDoc_Source
> Set oRange = .Range
>
> n = 1 'used to count below
>
> With oRange.Find
> .Text = "<[A-Z]{3" & strListSep & "}>"
> .Forward = True
> .Wrap = wdFindStop
> .Format = False
> .MatchCase = True
> .MatchWildcards = True
> Do While .Execute
> 'Continue while found
> strAcronym = oRange
> 'Insert in target doc
>
> 'If strAcronym is already in strAllFound, do not add again
> If InStr(1, strAllFound, "#" & strAcronym & "#") = 0 Then
> 'Add new row in table from second acronym
> If n > 1 Then oTable.Rows.Add
> 'Was not found before
> strAllFound = strAllFound & strAcronym & "#"
>
> 'Insert in column 1 in oTable
> 'Compensate for heading row
> With oTable
> .Cell(n + 1, 1).Range.Text = strAcronym
> 'Insert page number in column 3
> .Cell(n + 1, 3).Range.Text =
> oRange.Information(wdActiveEndPageNumber)
> End With
>
> n = n + 1
> End If
>
> 'If acronym
> Loop
> End With
> End With
>
> 'Sort the acronyms alphabetically
> With Selection
> .Sort ExcludeHeader:=True, FieldNumber:="Column 1", SortFieldType _
> :=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending
>
> .HomeKey (wdStory)
> End With
>
> 'Clean up
> Set oDoc_Source = Nothing
> Set oDoc_Target = Nothing
> Set oTable = Nothing
>
> MsgBox "Finished extracting " & n - 1 & " acronymn(s) to a new document."
>
> End Sub
>
> --
> Regards
> Lene Fredborg - Microsoft MVP (Word)
> DocTools - Denmark
> www.thedoctools.com
> Document automation - add-ins, macros and templates for Microsoft Word
>
>
> "BHW" wrote:
>
> > Hi,
> >
> > Back in '02 Mark Tangard suggested this snippet to find macros.
> > With Selection.Find
> > .Text = "<[A-Z]{3,}>"
> > .Forward = True
> > .Wrap = wdFindStop
> > .Format = False
> > .MatchCase = True
> > .MatchWildcards = True
> > .Execute
> > End With
> >
> > Has anyone (or would anyone like to) used this to create a fuller
> > macro that reads through file 1, finds acronyms, and writes them and
> > the page number to file 2? Alternatively, has anyone written a macro
> > that finds the first use of an acronym and somehow checks that it is
> > indeed defined (and only defined once!) with that first use?
> >
> > Cheers, Bruce
> >

I created the macro based on the question in the original post in this
thread. The macro could be adjusted to insert the table in the active
document instead. What you request is more complex - but actually, after I
created the acronym macro, I added something similar (maybe less advanced) to
my “macro idea list” (may be created some day when I find the time…).

For ideas on how you could create what you refer to as infotips, see this
thread:
http://groups.google.com/group/micro...addd74a327251b

Word 2007 does not have any dedicated functionality for creating infotips.
The AutoTextList method described in the thread above can also be used in
Word 2007.

--
Regards
Lene Fredborg - Microsoft MVP (Word)
DocTools - Denmark
www.thedoctools.com
Document automation - add-ins, macros and templates for Microsoft Word


"DaveB" wrote:

> Thanks for making this macro public. I was looking for one that has this
> type of functionality. But, I was hoping it would create the glossary in the
> beginning of the document and to also create infotips for each instance of an
> acronym's usage, such that, in the body of the document, the infotip pops up
> with the definition from the glossary. [I suppose you could extend this idea
> to centralize the glossary in one (or more) external documents by having the
> macro prompt for the path to the external doc prior to performing its
> function or leveraging a reference at the beginning of the document, to the
> external glossary document. ]
>
> I could not figure out how to create infotips easily (I am currently using
> Office 2003. Does Office 2007 address this functional concern?).
>
> "Lene Fredborg" wrote:
>
> > Below you will find a macro that extracts all words consisting of three or
> > more uppercase letters to a new document. I have added comments in the code
> > that explains what is going on. You may want to add more code to adjust the
> > layout of the table into which the acronyms are inserted. I just made the
> > macro and tested it on a small test document and it seems to work correctly –
> > however, you may want to adjust what it does.
> >
> >
> > Sub ExtractAcronymsToNewDocument()
> >
> > 'Finds all words consisting of 3 or more uppercase letters
> > 'in active document document and inserts the words
> > 'in column 1 of a 3-column table in a new document
> > 'Each acronym is added only once
> > 'Room for definition in column 2
> > 'Page number of first occurrence is added in column 3
> >
> > Dim oDoc_Source As Document
> > Dim oDoc_Target As Document
> > Dim strListSep As String
> > Dim strAcronym As String
> > Dim oTable As Table
> > Dim oRange As Range
> > Dim n As Long
> > Dim strAllFound As String 'use to keep track of foudnd
> >
> > 'Find the list separator from international settings
> > 'In some countries it is comma, in other semicolon
> > strListSep = Application.International(wdListSeparator)
> >
> > strAllFound = "#"
> >
> > Set oDoc_Source = ActiveDocument
> > 'Create new document for acronyms
> > Set oDoc_Target = Documents.Add
> >
> > With oDoc_Target
> > 'Make sure document is empty
> > .Range = ""
> >
> > 'Insert a table with room for acronym and definition
> > Set oTable = .Tables.Add(Range:=.Range, NumRows:=2, NumColumns:=3)
> > With oTable
> > 'Format the table a bit
> > 'Insert headings
> > .Cell(1, 1).Range.Text = "Acronym"
> > .Cell(1, 2).Range.Text = "Definition"
> > .Cell(1, 3).Range.Text = "Page"
> > 'Set row as heading row
> > .Rows(1).HeadingFormat = True
> > .Rows(1).Range.Font.Bold = True
> > .PreferredWidthType = wdPreferredWidthPercent
> > .Columns(1).PreferredWidth = 20
> > .Columns(2).PreferredWidth = 70
> > .Columns(3).PreferredWidth = 10
> > End With
> > End With
> >
> > With oDoc_Source
> > Set oRange = .Range
> >
> > n = 1 'used to count below
> >
> > With oRange.Find
> > .Text = "<[A-Z]{3" & strListSep & "}>"
> > .Forward = True
> > .Wrap = wdFindStop
> > .Format = False
> > .MatchCase = True
> > .MatchWildcards = True
> > Do While .Execute
> > 'Continue while found
> > strAcronym = oRange
> > 'Insert in target doc
> >
> > 'If strAcronym is already in strAllFound, do not add again
> > If InStr(1, strAllFound, "#" & strAcronym & "#") = 0 Then
> > 'Add new row in table from second acronym
> > If n > 1 Then oTable.Rows.Add
> > 'Was not found before
> > strAllFound = strAllFound & strAcronym & "#"
> >
> > 'Insert in column 1 in oTable
> > 'Compensate for heading row
> > With oTable
> > .Cell(n + 1, 1).Range.Text = strAcronym
> > 'Insert page number in column 3
> > .Cell(n + 1, 3).Range.Text =
> > oRange.Information(wdActiveEndPageNumber)
> > End With
> >
> > n = n + 1
> > End If
> >
> > 'If acronym
> > Loop
> > End With
> > End With
> >
> > 'Sort the acronyms alphabetically
> > With Selection
> > .Sort ExcludeHeader:=True, FieldNumber:="Column 1", SortFieldType _
> > :=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending
> >
> > .HomeKey (wdStory)
> > End With
> >
> > 'Clean up
> > Set oDoc_Source = Nothing
> > Set oDoc_Target = Nothing
> > Set oTable = Nothing
> >
> > MsgBox "Finished extracting " & n - 1 & " acronymn(s) to a new document."
> >
> > End Sub
> >
> > --
> > Regards
> > Lene Fredborg - Microsoft MVP (Word)
> > DocTools - Denmark
> > www.thedoctools.com
> > Document automation - add-ins, macros and templates for Microsoft Word
> >
> >
> > "BHW" wrote:
> >
> > > Hi,
> > >
> > > Back in '02 Mark Tangard suggested this snippet to find macros.
> > > With Selection.Find
> > > .Text = "<[A-Z]{3,}>"
> > > .Forward = True
> > > .Wrap = wdFindStop
> > > .Format = False
> > > .MatchCase = True
> > > .MatchWildcards = True
> > > .Execute
> > > End With
> > >
> > > Has anyone (or would anyone like to) used this to create a fuller
> > > macro that reads through file 1, finds acronyms, and writes them and
> > > the page number to file 2? Alternatively, has anyone written a macro
> > > that finds the first use of an acronym and somehow checks that it is
> > > indeed defined (and only defined once!) with that first use?
> > >
> > > Cheers, Bruce
> > >

Is there a way to generate the acronym definition in the second column of the table? The macro works great except for including the definition, which is a major part of the acronym list.