Stable change to structure level 'Body Text'

[RobiNew]

I want to reduce the structure level to 'Body Text'. I'm using the code here below to 1. change all styles to 'Normal'; 2. change structure level to 'Body Text'. The code works properly (even without part 1), but when the doc is further elaborated the original level reappears (Level 1). Is there a more reliable code to obtain a stable change of structure level? Thanks!

Sub BodyText()
'1. All paragraphs with Normal style
On Error Resume Next
Set MyStyle = ActiveDocument.Styles.Add(Name:="Normal", _
 Type:=wdStyleTypeParagraph)
    Dim Para As Paragraph
    Dim fnt As Font
    Dim pfmt As ParagraphFormat
    For Each Para In ActiveDocument.Paragraphs
        With Para
            If .Style <> ActiveDocument.Styles("Normal") Then
                Set fnt = .Style.Font
                Set pfmt = .Style.ParagraphFormat
                .Style = ActiveDocument.Styles("Normal")
                .Range.Font = fnt
                .Range.ParagraphFormat = pfmt
            End If
        End With
    Next
'2. Structure level to "Body text"
Dim myRange As Range
    For Each Paragraph In ActiveDocument.Paragraphs
NrPar = NrPar + 1
Set myRange = ActiveDocument.Paragraphs(NrPar).Range
myRange.Style = ActiveDocument.Styles(wdStyleNormal)
    Next Paragraph
End Sub