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

Guessed · #2 08-03-2021, 10:56 AM

Firstly, to remove the autonumbers, this code is simpler

Code:

Sub NumberingDeleteHardcoded()
  'Only acts on selected paragraphs
  Dim iResp As Integer
  iResp = MsgBox("This macro will remove all hardcoded paragraph numbers " _
    & vbCr & "from the SELECTED paragraphs. Click OK to continue.", _
    vbOKCancel, "Delete Hard Numbers")
  If iResp = vbOK Then
    WordBasic.ToolsBulletsNumbers Replace:=0, Type:=1, Remove:=1
  End If
End Sub

Secondly, if the right paragraph style is applied and those styles are defined correctly, to get the alignment correct all you need to do is reset the paragraph attributes to remove local overrides.

Code:

Selection.ParagraphFormat.Reset

Shelley Lou · #3 08-04-2021, 12:24 AM

Oh wow Andrew thank you so much, definitely much simpler and works a treat, much appreciated

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