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