View Single Post
Old 08-06-2022, 07:03 PM
jec1 jec1 is offline Windows 10 Office 2019
Advanced Beginner
Join Date: Jan 2012
Posts: 84
jec1 is on a distinguished road
Default AutoNumber manual numbered documents

Hi, just following on from Shelley Lou's post with Macropod and others re autonumbering different styled documents.

I attach BEFORE doc and AFTER doc. In the after doc the macro ceases at 3.7 Test for some reason. I tried making the heading longer but it didn't make a difference.

I have been using the macro below from Macropod:

Sub ApplyHeadingStyles_Auto1Works1()
Application.ScreenUpdating = False
Dim Para As Paragraph, Rng As Range, i As Long, StrTxt As String, bLvl As Boolean
Dim objUndo As UndoRecord: Set objUndo = Application.UndoRecord
With ActiveDocument.Range
  For Each Para In .Paragraphs
    With Para
      Set Rng = .Range.Characters.First
      With Rng
        If .text Like "[0-9(]" Then
          .MoveEndUntil " ", wdForward
          If InStr(.text, vbTab) > 0 Then
            .Collapse wdCollapseStart
            .MoveEndUntil vbTab, wdForward
          End If
          StrTxt = .text: bLvl = False
          .End = .End + 1
          objUndo.StartCustomRecord ("Fmt")
          For i = 1 To 6
            .Style = "Heading " & i
            If .ListFormat.ListString = StrTxt Then
              .text = vbNullString: bLvl = True: Exit For
            End If
          If bLvl = False Then ActiveDocument.Undo: DoEvents
        End If
      End With
    End With
End With
Application.ScreenUpdating = True
End Sub
Attached Files
File Type: docx Before Doc 1.docx (78.2 KB, 9 views)
File Type: docx After Doc 1 autonumber.docx (80.7 KB, 6 views)
Reply With Quote