#1
|
|||
|
|||
Acronym and definiton list generator
I have a 2006 "Acronym List Generator and Maintainer RevE" that I picked up along the way years ago. It's a .doc with a button inside that activates the macro. It extracts acronyms and their definitions from a target Word doc and appears to work fine in desktop Word 365. It steps through found acronyms and their definitions one by one, allowing alterations, and creates a 2-column table in a new doc.
I just wonder if anyone knows of an updated free (or very inexpensive, not the $85-and-up commercial programs) such utility that does not require stepping through each one but compiles all into a table, leaving it to the user to review the selections in the new table. In very long technical documents with lots of acronyms, this could be a significant time saver. All I find in searches is acronym finders, either the wildcard find version for 2 or more adjacent caps, but the definitions then need to be supplied. |
#2
|
||||
|
||||
The following macro checks the contents of a document for upper-case/numeric parenthetic abbreviations it then looks backwards to try to determine what term they abbreviate. For example:
World Wide Web (WWW) Naturally, given the range of acronyms in use, it’s not foolproof and, if a match isn’t made, the preceding sentence (in VBA terms) is captured so the user can edit the output. A table is then built at the end of the document, which is then searched for all references to the acronym (other than for the definition) and the counts and page numbers added to the table. Code:
Sub AcronymLister() Application.ScreenUpdating = False Dim StrTmp As String, StrAcronyms As String, i As Long, j As Long, k As Long, Rng As Range, Tbl As Table StrAcronyms = "Acronym" & vbTab & "Term" & vbTab & "Page" & vbTab & "Cross-Reference Count" & vbTab & "Cross-Reference Pages" & vbCr With ActiveDocument With .Range With .Find .ClearFormatting .Replacement.ClearFormatting .MatchWildcards = True .Wrap = wdFindStop .Text = "\([A-Z0-9][A-Z&0-9]{1" & Application.International(wdListSeparator) & "}\)" .Replacement.Text = "" .Execute End With Do While .Find.Found = True StrTmp = Replace(Replace(.Text, "(", ""), ")", "") If (InStr(1, StrAcronyms, .Text, vbBinaryCompare) = 0) And (Not IsNumeric(StrTmp)) Then If .Words.First.Previous.Previous.Words(1).Characters.First = Right(StrTmp, 1) Then For i = Len(StrTmp) To 1 Step -1 .MoveStartUntil Mid(StrTmp, i, 1), wdBackward .Start = .Start - 1 If InStr(.Text, vbCr) > 0 Then .MoveStartUntil vbCr, wdForward .Start = .Start + 1 End If If .Sentences.Count > 1 Then .Start = .Sentences.Last.Start If .Characters.Last.Information(wdWithInTable) = False Then If .Characters.First.Information(wdWithInTable) = True Then .Start = .Cells(.Cells.Count).Range.End + 1 End If ElseIf .Cells.Count > 1 Then .Start = .Cells(.Cells.Count).Range.Start End If Next End If StrTmp = Replace(Replace(Replace(.Text, " (", "("), "(", "|"), ")", "") StrAcronyms = StrAcronyms & Split(StrTmp, "|")(1) & vbTab & Split(StrTmp, "|")(0) & vbTab & .Information(wdActiveEndAdjustedPageNumber) & vbTab & vbTab & vbCr End If .Collapse wdCollapseEnd .Find.Execute Loop End With StrAcronyms = Replace(Replace(Replace(StrAcronyms, " (", "("), "(", vbTab), ")", "") Set Rng = ActiveDocument.Range.Characters.Last With Rng If .Characters.First.Previous <> vbCr Then .InsertAfter vbCr .InsertAfter Chr(12) .Collapse wdCollapseEnd .Style = "Normal" .Text = StrAcronyms Set Tbl = .ConvertToTable(Separator:=vbTab, NumRows:=.Paragraphs.Count, NumColumns:=5) With Tbl .Columns.AutoFit .Rows(1).HeadingFormat = True .Rows(1).Range.Style = "Strong" .Rows.Alignment = wdAlignRowCenter End With .Collapse wdCollapseStart End With For i = 2 To Tbl.Rows.Count StrTmp = "": j = 0: k = 0 With .Range With .Find .ClearFormatting .Replacement.ClearFormatting .Format = False .Forward = True .Text = Split(Tbl.Cell(i, 1).Range.Text, vbCr)(0) .MatchWildcards = True .Execute End With Do While .Find.Found = True If .InRange(Tbl.Range) Then Exit Do j = j + 1 If j > 0 Then If k <> .Duplicate.Information(wdActiveEndAdjustedPageNumber) Then k = .Duplicate.Information(wdActiveEndAdjustedPageNumber) StrTmp = StrTmp & k & " " End If End If .Collapse wdCollapseEnd .Find.Execute Loop End With Tbl.Cell(i, 4).Range.Text = j StrTmp = Replace(Trim(StrTmp), " ", ",") If StrTmp <> "" Then 'Add the current record to the output list (StrOut) StrTmp = Replace(Replace(ParseNumSeq(StrTmp, "&"), ",", ", "), " ", " ") End If Tbl.Cell(i, 5).Range.Text = StrTmp Next End With Set Rng = Nothing: Set Tbl = Nothing Application.ScreenUpdating = True End Sub Function ParseNumSeq(StrNums As String, Optional StrEnd As String) 'This function converts multiple sequences of 3 or more consecutive numbers in a ' list to a string consisting of the first & last numbers separated by a hyphen. ' The separator for the last sequence can be set via the StrEnd variable. Dim ArrTmp(), i As Long, j As Long, k As Long ReDim ArrTmp(UBound(Split(StrNums, ","))) For i = 0 To UBound(Split(StrNums, ",")) ArrTmp(i) = Split(StrNums, ",")(i) Next For i = 0 To UBound(ArrTmp) - 1 If IsNumeric(ArrTmp(i)) Then k = 2 For j = i + 2 To UBound(ArrTmp) If CInt(ArrTmp(i) + k) <> CInt(ArrTmp(j)) Then Exit For ArrTmp(j - 1) = "" k = k + 1 Next i = j - 2 End If Next StrNums = Join(ArrTmp, ",") StrNums = Replace(Replace(Replace(StrNums, ",,", " "), ", ", " "), " ,", " ") While InStr(StrNums, " ") StrNums = Replace(StrNums, " ", " ") Wend StrNums = Replace(Replace(StrNums, " ", "-"), ",", ", ") If StrEnd <> "" Then i = InStrRev(StrNums, ",") If i > 0 Then StrNums = Left(StrNums, i - 1) & Replace(StrNums, ",", " " & Trim(StrEnd), i) End If End If ParseNumSeq = StrNums End Function The following macro uses the table generated by the macro above to ensure each reference is listed in full, with its acronym, the first time it occurs in the document (e.g. Automated Teller Machine (ATM)) and thereafter as just the acronym (i.e. ATM). If you were to then delete the table produced by the macro above and re-run that macro, you'd possibly get a different result - depending on how many erroneous entries there were in the unedited document. Code:
Sub AcronymManager() Application.ScreenUpdating = False Dim Rng As Range, Tbl As Table, j As Long, k As Long, r As Long, StrTmp As String, StrExp As String, StrAcc As String With ActiveDocument Set Tbl = .Tables(.Tables.Count) For r = 2 To Tbl.Rows.Count Set Rng = .Range Rng.End = Tbl.Range.Start With Rng.Find .ClearFormatting .Replacement.ClearFormatting .MatchWholeWord = True .MatchCase = True .Forward = True .Wrap = wdFindStop StrAcc = Split(Tbl.Cell(r, 1).Range.Text, vbCr)(0) StrExp = Split(Tbl.Cell(r, 2).Range.Text, vbCr)(0) .Text = StrExp .Replacement.Text = StrAcc .Execute Replace:=wdReplaceAll .Text = StrAcc & "^w" & "(" & StrAcc & ")" .Replacement.Text = StrAcc .Execute Replace:=wdReplaceAll End With With Rng.Find .Text = StrAcc .Replacement.Text = StrExp & " (" & StrAcc & ")" .Execute Replace:=wdReplaceOne If .Found = True Then Tbl.Cell(r, 3).Range.Text = Rng.Information(wdActiveEndAdjustedPageNumber) End With Next For r = 2 To Tbl.Rows.Count StrTmp = "": j = 0: k = 0 With .Range With .Find .ClearFormatting .Replacement.ClearFormatting .Format = False .Forward = True .Text = Split(Tbl.Cell(r, 1).Range.Text, vbCr)(0) .MatchWildcards = True .Execute End With Do While .Find.Found = True If .InRange(Tbl.Range) Then Exit Do With Tbl.Cell(r, 3).Range If Split(.Text, vbCr)(0) = "" Then .Text = Rng.Information(wdActiveEndAdjustedPageNumber) End With j = j + 1 If j > 0 Then If k <> .Duplicate.Information(wdActiveEndAdjustedPageNumber) Then k = .Duplicate.Information(wdActiveEndAdjustedPageNumber) StrTmp = StrTmp & k & " " End If End If .Collapse wdCollapseEnd .Find.Execute Loop End With Tbl.Cell(r, 4).Range.Text = j StrTmp = Replace(Trim(StrTmp), " ", ",") If StrTmp <> "" Then 'Add the current record to the output list (StrOut) StrTmp = Replace(Replace(ParseNumSeq(StrTmp, "&"), ",", ", "), " ", " ") End If Tbl.Cell(r, 5).Range.Text = StrTmp Next End With Application.ScreenUpdating = True End Sub For PC macro installation & usage instructions, see: Installing Macros For Mac macro installation & usage instructions, see: Word:mac - Install a Macro
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] Last edited by macropod; 06-18-2022 at 04:09 AM. Reason: AcronymManager revised per feedback from guessed - see post #10 |
#3
|
|||
|
|||
Wunderbar!
Paul, I haven't had a chance to try out the macro yet, but I have no doubt it will be superb. Thank you!
It continually amazes me that we are able to get this kind of top-level asistance for free, and usually so promptly. I'ts wonderful that you, and others, offer your expertise. |
#4
|
|||
|
|||
This worked for me, but I have questions..
Paul,
Good morning from Virginia! I realize that this post is ten years old, but I'm hoping I can still gets some assistance with the macro you provided. I made minor changes to suit my needs better: 1. Changed the following because we use section breaks in our documents: Code:
wdActiveEndAdjustedPageNumber Code:
wdActiveEndPageNumber Code:
.Columns.AutoFit One of the issues I'm having is that the terms are not being pulled and placed into the Term column, or it pulls the term(s) and the entire sentence it was in. I had a thought where I could try to make it find the words that start with each letter in the acronym, and place them into the table. But some of our acronyms are more like abbreviations, so that won't work. Issue #2: In the line below, you have 6 pairs of double quotes, some of which surround an open or closed parenthesis, but I can't figure out what the "|" is for. What is that, and why is there 6 pairs of double quotes? Code:
StrTmp = Replace(Replace(Replace(.Text, " (", "("), "(", "|"), ")", "") I'm going to try and massage it more to get it to do what I need it to, but would like to ask you more questions if you're available. Thanks for the macro and your time! |
#5
|
||||
|
||||
Methinks you need your eyes checked - it's not yet two months old...
Quote:
Quote:
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#6
|
|||
|
|||
My apologies
I looked at the date in the wrong corner, which is why I assume the ten year span. Forums are a whole new world to me, so I'll be careful next time.
As for my first issue, I did read the preceding comment, and I understood it. I just can't understand why the macro is pulling nothing for many of the acronyms; I'm getting blank cells. As for my second issue, I wasn't questioning whether the code is correct. I was simply asking why the difference in pairs of parentheses and what the bar symbol meant. But as I said before, I'm going to try to get it to work the way I need it to. So thanks. |
#7
|
||||
|
||||
If you break down:
StrTmp = Replace(Replace(Replace(.Text, " (", "("), "(", "|"), ")", "") you'll see there are three nested Replace(expression, find, replace) functions. As each such function has its own parentheses, it is only those that need to be balanced - the ones in quotes are parts of the find/replace variables.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#8
|
|||
|
|||
Modify macro to generate table in a new document and sort alphabetically
Thank you for the macro, this has been very useful - is there a way to modify the macro so that the acronym list generates in a new document and is sorted alphabetically?
Best regards, Jennifer |
#9
|
||||
|
||||
I'm not sure what the point of generating the list in a separate document would be. Nevertheless, that could be done by inserting:
Documents.Add before: Set Rng = ActiveDocument.Range.Characters.Last and delete or comment-out: Code:
If .Characters.First.Previous <> vbCr Then .InsertAfter vbCr .InsertAfter Chr(12) .Collapse wdCollapseEnd Code:
.Sort ExcludeHeader:=True, FieldNumber:="Column 1", CaseSensitive:=False, _ SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending Code:
With Tbl ... End With
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#10
|
||||
|
||||
Yes, the code can be adapted to output to an Excel worksheet. See this thread for a code example that could be adapted to this task.
https://www.msofficeforums.com/word-...perscript.html To include lower case is a bit more difficult as it requires tradeoffs and decisions. It most likely requires multiple passes This existing search string finds capitals and numbers with at least two characters .Text = "\([A-Z0-9][A-Z&0-9]{1" & Application.International(wdListSeparator) & "}\)" To include lowercase characters you need to include multiple passes to keep out regular camel case words (eg Hello, To, iPhone) but get three+ character instances (eg BoM, MgO2). A search string for that might be .Text = "\([A-Z0-9][a-z&][A-Z&0-9]{1" & Application.International(wdListSeparator) & "}\)"
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#11
|
|||
|
|||
Paul, thank you. Your macros in post #2 are not working in a document I have. I have run the first in a couple of other documents, and it fairly quickly creates the table at the end. I don't know why it's balking on this one. I have accepted all changes deleted the comments, and have nothing displayed from the track changes menu. I don't offhand see anything in the document that stands out as a potential problem, and the document is on my desktop. But running the Lister macro simply hangs the machine. After about 15 seconds, Word Not Responding comes on and the blue "working" circle churns away. I let it go for a half hour and finally used task manager to close Word.
Since it's a proposal, I can't post it. Maybe the macro will work after full DTP is complete. Unless you have ideas of what might be causing the issue. Thank you. |
#12
|
||||
|
||||
Assuming you're having problems with the 'AcronymLister' sub:
• comment out 'Application.ScreenUpdating = False' • insert: Code:
.Select Msgbox .Text That will show you what has been matched on each iteration and should allow you to identify where in the document the code hangs.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#13
|
|||
|
|||
Hello again, and thank you. I made the changes you offered.
The document stops producing the pop-ups after about a dozen acronyms. The next such item, just a sentence or two down, is "(SAFe)". Could it be that the lower-case letter is causing the problem? Scanning the document I see other terms, such as (APIs) and (IaaS). I am ever grateful for your continued support. |
#14
|
||||
|
||||
The code in post #2 only processes acronyms in the form of (A1B2C3) - that is finds capitals and numbers with at least two characters - and would only skip over acronyms like (SAFe). Andrew provided an adaptation in post #10 to incorporate lower-case characters.
Whichever variant you used, the code would have hung on the one that produced the last message box.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#15
|
|||
|
|||
Well, something is going awry; I have no idea what. Two of us have tried Andrew's variation to no avail; it still hangs. I can't figure out why it is hanging at a 3-cap acronym, after which the very next one is the same, with different letters. There is no parenthesis in between the two, which are even on the same page.
So, it seems that the two-pass solution, unless I have misunderstood it, is stymied in this case, because neither Paul's nor Andrew's will continue past a fairly early page, each hanging at a different point. Let me say that we have done this by inserting Andrew's line under Paul's and commenting it out, and then tried commenting out Paul's and enabling Andrew's. There must be something I am not getting about running these (surprise, surprise). I'm sorry I can't send the text. |
Tags |
acronymlister macro |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Adding List Number to Acronym Table | SerenityNetworks | Word VBA | 6 | 12-13-2016 01:36 PM |
Random Name Generator | knp11 | Word | 1 | 01-18-2015 11:41 AM |
Need guidance on creating a Word doc generator | mikeman | Word VBA | 1 | 10-26-2014 10:35 PM |
Acronym Finder | Cray_Z | Word VBA | 14 | 09-22-2014 11:42 PM |
Document Generator | HJJ | Word | 0 | 08-12-2009 03:28 AM |