• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 586
  • Last Modified:

Acronym management by Word style rather than text content or minimal length

This question is related to the following:<http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Word/Q_24271064.html?sfQueryTermInfo=1+10+acronym>

Instead of searching for particular acronym content, or a minimal length of uppercase characters, can modified code search for any string that has a particular character Style?  For example, capture every string that has the "Acronym" style applied to it?  I'm not a VBA guy, though I suspect that only the search technique needs to change.

The final code from the prior question is attached.

Thanks for your consideration,

1 Solution
whitneybroachAuthor Commented:
Well, I tried to embed the code to make it easier to access, but that didn't work.  Here's another attempt:

Sub ExtractAcronymsToNewDocument()
'Finds all words consisting of 2 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
'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]{2" & 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
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
Joanne M. OrzechManager, Document Services CenterCommented:
I'm not so sure about VBA in this instance, but you can always select all instances of text at once which have a character style applied.  Here's how:

1.  Tools, Options, Edit, be sure "Keep track of formatting" is checked.
2.  Go to your document
3.  Format, Styles and Formatting, click on the style "Acronym"
4.  In the dropdown box to the right of style, select "Select All # Instances"

Hope this helps a little.

Featured Post

Vote for the Most Valuable Expert

It’s time to recognize experts that go above and beyond with helpful solutions and engagement on site. Choose from the top experts in the Hall of Fame or on the right rail of your favorite topic page. Look for the blue “Nominate” button on their profile to vote.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now