You are correct about that. Below is a revised version of the macro. Although it can't address that particular problem, it should run more efficiently.
Where you find that the macro hasn't processed all content, you can correct the document error at whatever point that was (e.g. by temporarily inserting a paragraph with the missing numbering) , then run the macro again and have it automatically resume processing from that point. Your document, for example, has a missing paragraph break, such that two numbered paragraphs have been joined, thus breaking the numbering sequence. Of course, if you insert temporary paragraphs, you will then have the question of what to do about them once the processing has finished. If you delete them, the auto-numbering will auto-update but, if you don't want that, about your only recourse would be to mark them as hidden or include a note as to why they're there. It all depends on how important it might be to preserve the original numbering.
Code:
Sub ApplyHeadingStyles_Auto()
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
Next
objUndo.EndCustomRecord
If bLvl = False Then ActiveDocument.Undo: DoEvents
End If
End With
End With
Next
End With
Application.ScreenUpdating = True
End Sub