Microsoft Office Forums - View Single Post - [Solved] Oh Please Lawd Halp me figure out how to make formatting these damnable documents a smaller job

macropod · 09-18-2014, 10:19 PM

I've had a look at your onedrive document. Sadly, it doesn't make any use of Word's Styles. Everything is in Word's Normal Style, overridden with hard formatting so that nothing in your document seems to look like what the Normal Style says it should. That makes even a manual conversion much harder than it needs to be. It also makes the document harder to maintain and more prone to corruption. Even your table of contents, because the document doesn't make use of Styles, has to be manually prepared, whereas in a document using Styles it can be generated and updated quite easily.

Just to give you an idea of what's possible, copy & paste the document from the link in your first post into a new document, as unformatted text. Then run the following macro. For PC macro installation & usage instructions, see: http://www.gmayor.com/installing_macro.htm

Code:

Sub ReformatStatuteText()
' Turn Off Screen Updating
Application.ScreenUpdating = False
Dim TrkStatus As Boolean      ' Track Changes flag
With ActiveDocument
  ' Store current Track Changes status, then switch off
  TrkStatus = .TrackRevisions
  .TrackRevisions = False
  With .Range.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True
    'Delete paragraphs containing just tabs
    .Text = "[^t]@^13"
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll
    'Replace all double spaces with single spaces
    .Text = "[ ]{2,}"
    .Replacement.Text = " "
    .Execute Replace:=wdReplaceAll
    'Limit paragraph breaks and manual line breaks to one 'real' paragraph per set.
    .Text = "[^13^11]{1,}"
    .Replacement.Text = "^p"
    .Execute Replace:=wdReplaceAll
    'Delete 'Acts' paragraphs
    .Text = "^13Acts [0-9]{4}*^13"
    .Replacement.Text = "^p"
    .Execute Replace:=wdReplaceAll
    'ReFormat 'Title' paras
    .Format = True
    .Text = "TITLE ([0-9]{1,}. )(*^13)"
    .Replacement.Text = "Part \1- \2"
    .Replacement.Style = "Heading 1"
    .Execute Replace:=wdReplaceAll
    'ReFormat 'CHAPTER' paras
    .Text = "CHAPTER [0-9]{1,}. (*^13)"
    .Replacement.Text = "\1"
    .Replacement.Style = "Heading 2"
    .Execute Replace:=wdReplaceAll
    'ReFormat 'CHAPTER' paras
    .Format = False
    .Text = "(Art. [0-9.]{1,} [!.]@.) (*^13)"
    .Replacement.Text = "\1^p\2"
    .Execute Replace:=wdReplaceAll
    .Format = True
    .Text = "Art. [0-9.]{1,} [!.]@.^13"
    .Replacement.Text = "^&"
    .Replacement.Style = "Heading 3"
    .Execute Replace:=wdReplaceAll
  End With
  ' Restore original Track Changes status
  .TrackRevisions = TrkStatus
End With
' Restore Screen Updating
Application.ScreenUpdating = True
End Sub

The macro does some basic clean-up work, then applies Word's Heading 1, 2 & 3 Styles to the various headings. All this is done using Find/Replace sequences you could do manually via the Find/Replace dialogue. Granted, the results probably don't reflect what you want for the final output, but simply modifying the heading Styles to suit, including with the use of multi-level list numbering, can generate that output. Note how the macro doesn't do any direct formatting - it just calls the Styles for that. Change any of those Styles' definitions, even after running the macro, and all the corresponding headings will change.

To make full use of this approach, you really do need to learn to use Styles - and to use them consistently. The time taken to do so will very quickly pay for itself. Check out Charles' links.