![]() |
#1
|
|||
|
|||
![]()
I've been using Greg and Graham's macro to generate an acronym list. It works great. But I'd like to add a column that provides the list number under which the acronym falls. I'm not a coder and have no idea how to accomplish this task.
Code:
For example, on page 1 we have: 1. text 1.1 text RO Real Options 1.2 text 1.2.1 text BOB Big Ol' Bill 1.2.2 Syzygy Goes Wild (SGW) text 1.3 text I would like returned: RO 1 1.1 RO Real Options BOB 1 1.2.1 BOB Big Ol' Bill SGW 1 1.2.2 Syzygy Goes Wild (SGW) Thank you in advance, Andrew Code:
Sub GetAcronymsTEST() 'A basic Word macro coded by Greg Maxey 'http://gregmaxey.mvps.org/word_tips.html 'Modified by Graham Mayor 'http://www.gmayor.com Dim oCol As New Collection Dim oColPN As New Collection Dim oColLN As New Collection 'added (for list number) Dim oColTxt As New Collection Dim oTable As Table Dim oCell As Range Dim oRng As Word.Range Dim oDoc As Word.Document Dim lngIndex As Long Set oRng = ActiveDocument.Range With oRng.Find .Text = "<[A-Z]{1,4}>" .MatchWildcards = True While .Execute oCol.Add oRng.Text oColTxt.Add oRng.Sentences(1).Text oColPN.Add oRng.Information(wdActiveEndPageNumber) 'call a sub to find previous Paragraphs(1).Range.ListFormat.ListString and put it here oRng.Collapse wdCollapseEnd Wend End With Set oDoc = Documents.Add Set oTable = oDoc.Tables.Add(oDoc.Range, 1, 4) 'changed 3 to 4 oTable.Columns(1).Width = CentimetersToPoints(2.5) oTable.Columns(2).Width = CentimetersToPoints(1.5) oTable.Columns(3).Width = CentimetersToPoints(2.5) 'added oTable.Columns(4).Width = CentimetersToPoints(9) For lngIndex = 1 To oCol.Count Set oCell = oTable.Rows.Last.Cells(1).Range oCell.End = oCell.End - 1 oCell.Text = oCol(lngIndex) Set oCell = oTable.Rows.Last.Cells(2).Range oCell.End = oCell.End - 1 oCell.Text = oColPN(lngIndex) Set oCell = oTable.Rows.Last.Cells(3).Range oCell.End = oCell.End - 1 oCell.Text = oColLN(lngIndex) Set oCell = oTable.Rows.Last.Cells(4).Range 'added oCell.End = oCell.End - 1 'added oCell.Text = oColTxt(lngIndex) 'added If lngIndex < oCol.Count Then oTable.Rows.Add Next lngIndex oTable.Sort ExcludeHeader:=False, FieldNumber:="Column 1", _ SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending, _ FieldNumber2:="Column 2", SortFieldType2:=wdSortFieldNumeric, SortOrder2 _ :=wdSortOrderAscending lbl_Exit: Set oDoc = Nothing Set oRng = Nothing Set oTable = Nothing Set oCell = Nothing Set oCol = Nothing Set oColPN = Nothing Set oColTxt = Nothing Exit Sub End Sub |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
adding tables based on a number given in a form | coba | Word VBA | 5 | 12-26-2015 07:05 PM |
![]() |
Cray_Z | Word VBA | 14 | 09-22-2014 11:42 PM |
![]() |
Cellendhyll | Word Tables | 3 | 07-10-2014 05:49 AM |
![]() |
spthomas | Word | 12 | 12-16-2013 05:23 PM |
![]() |
Daved2424 | Word | 6 | 01-22-2011 07:11 PM |