When documents are converted from pdf to Word to be put into housestyle, the manual numbering can often be an issue. I am trying to put together a macro that will format the manual numbering to be 1. / 1.1 / 1.1.1 / 1.1.1.1 so that I can run my auto numbering macro without it running into errors.
For the first level manual numbering, the code needs to add a period if there isn't one already there (eg from 1 to be 1. otherwise the auto numbering macro won't work.
For the second, third and fourth level numbering (e.g. 1.1 or 1.1.1 or 1.1.1.1) I need the code to remove periods at the end of the manual numbering if they are present and that the periods between the manual numbering are in fact periods and not spaces, tabs, commas, semi-colons, colons etc.
I'm running into errors with my code below - can anyone help me fine tune the code. Thanks
format manual numbering before running auto numbering code.docx
Code:
Sub FormatManualNumbering()
Application.ScreenUpdating = False
With ActiveDocument
With .Range
With .Find
.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchWildcards = True
.Replacement.ClearFormatting
.text = "(^13)([0-9]@{1,})([ ^t])" 'insert period at end of manual numbering level 1 if there isn't one already there
.Replacement.text = "\1\2.\3"
.Execute Replace:=wdReplaceAll
End With
With .Find
.ClearFormatting
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchWildcards = True
.Replacement.ClearFormatting
.text = "(^13)([0-9]@{1,}([.\,\:\;\ ])[0-9]{1,})([.])([ ^t])" 'insert period for manual numbering level 1.1 and remove period at end
.Replacement.text = "\1\2.\"
.Execute Replace:=wdReplaceAll
.text = "(^13)([0-9]@{1,}([.\,\:\;\ ])[0-9]{1,}([.\,\:\;\ ])[0-9]{1,})([.])([ ^t])" 'insert period for manual numbering level 1.1.1 and remove period at end
.Replacement.text = "\1\2.\3.\4"
.Execute Replace:=wdReplaceAll
.text = "(^13)([0-9]@{1,}([.\,\:\;\ ])[0-9]{1,}([.\,\:\;\ ])[0-9]{1,}([.\,\:\;\ ])[0-9]{1,})([.])([ ^t])" 'insert period for manual numbering level 1.1.1.1 and remove period at end
.Replacement.text = "\1\2.\3.\4"
.Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
End With
End With
End Sub