#1
|
|||
|
|||
VBA code to convert Heading 1, 2, 3 etc. numbering
Hi, I am trying to write code to firstly convert auto numbering to manual then convert the Heading 1, 2, 3 numbering to Schedule Level numbering. I've got the code to work but at the moment it is converting all auto numbering to manual. How can I get the first bit of the code to only convert the Heading 1, 2 numbering to manual and leave everything else as it is. The code works to insert Schedule Level numbering as auto but it leaves in the manual number after the auto numbering - is there a way I can remove the manual number also. If you run the code on the attached document you will see what I mean.
Many thanks in advance of help. Shelley Code:
Sub DPU_ConvertToScheduleNum() ActiveDocument.Range.ListFormat.ConvertNumbersToText Selection.Find.Style = ActiveDocument.Styles("Heading 1") Selection.Find.Replacement.Style = ActiveDocument.Styles( _ "Schedule Level 1") With Selection.Find .Text = "[0-9.]@^t" .Replacement.Text = "" End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.Style = ActiveDocument.Styles("Heading 2") Selection.Find.Replacement.Style = ActiveDocument.Styles( _ "Schedule Level 2") With Selection.Find .Text = "[0-9.0-9]@^t" .Replacement.Text = "" End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.Style = ActiveDocument.Styles("Heading 3") Selection.Find.Replacement.Style = ActiveDocument.Styles( _ "Schedule Level 3") With Selection.Find .Text = "[0-9.0-9.0-9]@^t" .Replacement.Text = "" End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.Style = ActiveDocument.Styles("Heading 4") Selection.Find.Replacement.Style = ActiveDocument.Styles( _ "Schedule Level 4") With Selection.Find .Text = "[0-9.0-9.0-9.0-9.0-9]@^t" .Replacement.Text = "" End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.Style = ActiveDocument.Styles("Heading 5") Selection.Find.Replacement.Style = ActiveDocument.Styles( _ "Schedule Level 5") With Selection.Find .Text = "[\(][a-z][\)]^t" .Replacement.Text = "" End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.Style = ActiveDocument.Styles("Heading 6") Selection.Find.Replacement.Style = ActiveDocument.Styles( _ "Schedule Level 6") With Selection.Find .Text = "[\(][a-z][\)]^t" .Replacement.Text = "" End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.Style = ActiveDocument.Styles("Heading 7") Selection.Find.Replacement.Style = ActiveDocument.Styles( _ "Schedule Level 7") With Selection.Find .Text = "[\(][A-Z][\)]^t" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll End Sub |
#2
|
||||
|
||||
It seems to me that all you need is:
Code:
Sub Demo() Application.ScreenUpdating = False Dim i As Long With ActiveDocument.Range.Find .ClearFormatting .Replacement.ClearFormatting .Text = "" .Replacement.Text = "" .Forward = True .Format = True .Wrap = wdFindContinue For i = 1 To 4 .Style = "Heading " & i .Replacement.Style = "Schedule Level " & i .Execute Replace:=wdReplaceAll Next End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
Hi Macropod
Thanks for this - I've run the code but it has a compile error variable not defined message and the word .Replacement was highlighted - any ideas? Thanks, Shelley Quote:
|
#4
|
||||
|
||||
The code runs fine for me - on your attachment. Try re-starting Word.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
|||
|
|||
Hi Macropod, many thanks for the tip it seems Word was playing up for me yesterday and its worked today. Thank you. Best wishes, Shelley
|
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Heading not following the correct numbering | jongleur | Word | 2 | 05-16-2017 10:52 AM |
Fixing my heading numbering | tomsrv | Word | 3 | 08-31-2016 12:17 AM |
Unhidden Heading Numbering | snmuvz | Word | 5 | 02-04-2015 08:01 PM |
Heading 3 numbering not working right | Dr Wu | Word | 2 | 04-02-2013 07:24 AM |
Heading numbering anomaly | Ulodesk | Word | 8 | 03-19-2012 01:57 PM |