VBA Remove manual numbering after Outline numbering

Shelley Lou · #1 08-03-2021, 10:29 AM

Views: 11 Size: 29.1 KB">TEST DOC FOR MANUAL NUMBERING.docx

Hi Guys
When converting documents from pdf to Word, I copy the text and paste into my template as unformatted text, I then go through and insert house style numbering. The macro below removes the manual numbering for Headings 1-6. The macro works but doesn't correctly line the paragraphs up re hanging at 0.5". When I do the steps as a find and replace it works but when put into VBA it doesn't work so not sure what I am doing wrong. I've tried putting .Replacement.Style = Heading 2 for example and that doesn't do anything for lining up the paragraphs.

The code at the moment only includes if the manual numbering is followed by a tab, but needs to include if it is a space as well.

Can anyone help at all.
Thanks, Shelley

Numbering.PNG

Code:

Sub DPU_RemoveManualNumbering()
Application.ScreenUpdating = False

With ActiveDocument
  With Range.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True

With Range.Find
    .Find.ClearFormatting
    .Find.Replacement.ClearFormatting
    .Text = "([0-9]@^t)(*)" 'Remove manual numbers from Heading 1
    .Replacement.Text = "\2"
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
      
    .Find.ClearFormatting
    .Find.Replacement.ClearFormatting
    .Text = "([0-9]@.[0-9]@^t)(*)" 'Remove manual numbers from Heading 2
    .Replacement.Text = "\2"
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
    
    .Find.ClearFormatting
    .Find.Replacement.ClearFormatting
    .Text = "([0-9]@.[0-9]@.[0-9]@^t)(*)" 'Remove manual numbers from Heading 3
    .Replacement.Text = "\2"
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
    
     .Find.ClearFormatting
    .Find.Replacement.ClearFormatting
    .Text = "([0-9]@.[0-9]@.[0-9]@^t)(*)" 'Remove manual numbers from Heading 4
    .Replacement.Text = "\2"
     .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
        
    .Find.ClearFormatting
    .Find.Replacement.ClearFormatting
    .Text = "([\(][a-z][\)]@^t)(*)" 'Remove manual letters and/or Roman numerals from Heading 5 & 6
    .Replacement.Text = "\2"
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
    
          
   .Find.ClearFormatting
    .Find.Replacement.ClearFormatting
    .Text = "([\(][A-Z][\)]@^t)(*)" 'Remove manual Uppercase letters in brackets from Heading 7
    .Replacement.Text = "\2"
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
    
    End With
         
    Application.ScreenUpdating = True
End Sub

Thread Tools
Show Printable Version Email this Page
Display Modes
Switch to Linear Mode Switch to Hybrid Mode Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
VBA converting manual numbering to auto numbering	Shelley Lou	Word VBA	8	05-28-2021 01:08 AM
page numbering for manual	Bursal	Word	1	07-29-2018 02:08 PM
How can I define a numbering style restarting numbering after an outline by default	jklocker	Word	1	09-26-2017 05:11 AM
Associate Outline Levels with Numbering	altjx	Word	2	04-17-2012 02:06 PM
Outline numbering: 2.1 coming out as 1.1	Remster	Word	3	12-07-2011 12:16 PM