VBA Remove manual numbering after Outline numbering

[Shelley Lou]

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

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]

Firstly, to remove the autonumbers, this code is simpler

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.

Selection.ParagraphFormat.Reset

[Shelley Lou]

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