#1
|
|||
|
|||
Formatted list of which heading a specific Style in 'under'
Hello. My first post here. I've searched first, so apologies if this has been covered.
We have an external person who 'owns' our large documents. They've just gone and added their 'instructions' in green text to the body of the quite empty new doc, like this mock up. I should add it is quite empty of body-text but has lots of 'shell' sections like this : 2.1 OverviewThey didn't even use a separate Style. "Sally" is actually an external contributor and I need to extract just 'her' sections, plus for the other parties...preferably into a Table or Excel list. This will be their work-list, they can check-off. I've managed to turn the Green bits into a new Style and build a manual TOC including it, which sort of does what I want, but not really. I'm wondering if I can use VBA to: a) Loop thru and find all my new "Instructions" (green) style b) Look back/up at what the 'nearest' heading is, i.e. that the Instructions 'belong' to (2.1.1 Network Structure) c) Write out the Instructions text and full heading to a table or CSV, like this '2.1.1 Network Structure', 'Get Sally to update this section to add the firewall' Thanks! |
#2
|
||||
|
||||
Do your 'headings' actually employ one of Word's heading Styles?
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
Thank you, yes they do use only the standard Heading 1 styles etc. The only non-std style is the one I had to add later, to mark-up the 'green' plain text.
That was how I created my temp workaround with the manual TOC. Please find attached the sample docm. Only the first 2 Instructions appear in the generated table. Thanks again. |
#4
|
||||
|
||||
Try:
Code:
Sub CompileInstructions() Application.ScreenUpdating = False Dim DocSrc As Document, DocTgt As Document, Rng As Range, r As Long Set DocSrc = ActiveDocument: Set DocTgt = Documents.Add With DocTgt .Tables.Add .Range, Numrows:=1, NumColumns:=2 End With With DocSrc.Range With .Find .ClearFormatting .Replacement.ClearFormatting .Text = "" .Replacement.Text = "" .Forward = True .Format = True .Style = "Instructions" .Wrap = wdFindStop .Execute End With Do While .Find.Found Set Rng = .Paragraphs(1).Range With DocTgt.Tables(1) .Rows.Add r = .Rows.Count With .Cell(r, 2).Range .FormattedText = Rng.FormattedText .Characters.Last.Previous.Delete End With End With Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel") With DocTgt.Tables(1) With .Cell(r, 1).Range .FormattedText = Rng.Paragraphs.First.Range.FormattedText 'or, if the output doesn't include all headings from the source '.Text = Rng.Paragraphs.First.Range.ListFormat.ListString & vbTab & Rng.Paragraphs.First.Range.Text .Characters.Last.Previous.Delete End With End With .Collapse wdCollapseEnd .Find.Execute Loop End With With DocTgt.Tables(1) .Cell(1, 1).Range.Text = "Section" .Cell(1, 2).Range.Text = "Instructions" .Rows(1).HeadingFormat = True .Rows(1).Range.Style = "Strong" End With Set Rng = Nothing: Set DocTgt = Nothing: Set DocSrc = Nothing Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] Last edited by macropod; 04-16-2018 at 02:38 PM. Reason: Code fixes |
#5
|
|||
|
|||
Done! Thanks again, that did the trick.
|
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Creating a list of all text in a specific style | ljd108 | Word VBA | 15 | 10-09-2014 02:35 AM |
Deleting A blank Line that has a specific heading style , word 2010 & 2013 | SteveWcg | Word | 5 | 01-08-2014 10:37 PM |
I create a new style but it fails to appear in Quick Style list | veronius | Word | 6 | 06-18-2013 06:29 PM |
Same Style for all Heading Levels | nesquik | Word | 4 | 05-13-2013 03:31 PM |
Macro to replace one specific heading style with another | ubns | Word VBA | 44 | 09-04-2012 08:17 PM |