Sub Macro1()
Dim oRng As Range
    Set oRng = ActiveDocument.Range

    With oRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "DEFINITION"
        .Style = "Heading 1"
        .Replacement.Text = "DEFINITION"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        Do While .Execute
            If ListParaNum(oRng.Paragraphs(1)) = 1 Then
                oRng.Paragraphs(1).Range.InsertBefore Chr(12)
                Exit Do
            End If
        Loop
    End With
End Sub

Private Function ListParaNum(oPara As Paragraph) As String
Dim i As Integer
Dim xRefs As Variant
    xRefs = ActiveDocument.GetCrossReferenceItems(wdRefTypeNumberedItem)
    ListParaNum = 0
    With oPara.Range
        If .ListParagraphs.Count = 0 Then
            GoTo lbl_Exit
        End If
        .Collapse wdCollapseEnd
        On Error Resume Next
        For i = 1 To UBound(xRefs)
            If ActiveDocument.ListParagraphs(i).Range.End = .End Then
                ListParaNum = Val(ActiveDocument.ListParagraphs(i).Range.ListFormat.ListString)
                Exit For
            End If
        Next i
    End With
lbl_Exit:
    Exit Function
End Function