Как в VBA Word получить/достать номера абзацов?

Sub KPI()
Dim wd As New Document
Set wd = ActiveDocument
tc = wd.Tables.Count
ReDim mas(1 To tc, 1 To 10)
For i = 1 To tc
    If i = 1 Then
        Set ps = wd.Range(0, wd.Tables(1).Range.Start - 1).Paragraphs
    Else
        Set ps = wd.Range(wd.Tables(i - 1).Range.End, wd.Tables(i).Range.Start - 1).Paragraphs
    End If
    For lp = ps.Count To 1 Step -1
        If Len(ps(lp)) > 5 Then
            mas(i, 1) = CleanString(ps(lp))
            Exit For
        End If
    Next
    For k = 1 To wd.Tables(i).Rows.Count
        mas(i, k + 1) = CleanString(wd.Tables(i).Cell(k, 2).Range)
    Next
Next
Set xl = CreateObject("Excel.Application")
xl.Visible = True
xl.Workbooks.Add.Sheets(1).Cells(1).Resize(tc, 10).Value = mas
Set xl = Nothing
End Sub

Sub MM221117KF21()
'' макрос должен вывести в отладке(ексель отключила)
''tables= 3
'' 0     1     34    СВЕДЕНИЯ ОБ ОСНОВНЫХ НЕДОСТАТКАХ
'' 1     1     38   1. НЕДОСТАТКИ ПО НАЧИСЛЕНИЮ ПРОЦЕНТОВ
'' 1     2     81   1.1 Недостатки по начислению процентов / Краткосрочные кредиты (риск – высокий)
'' 2     2     80   1.2 Недостатки по взысканию процентов / Среднесрочные кредиты (риск – средний)
'' 2     1     40   2. НЕДОСТАТКИ ПО ПЕРВИЧНОМУ МОНИТОРИНГУ
'' 1     2     50   2.1 Риски в программе CRM Bullit (риск – низкий)
 
Debug.Print "''tables="; Word.ActiveDocument.Tables.Count
Dim DOC As Document, J1, KT As Long, KX As Long
Dim S1, S1A, S2
 
Dim PR As Paragraph
Dim RN As Range
Dim MACT(0 To 10, 0 To 8) As String
Set DOC = Word.ActiveDocument
KT = 0
KX = 0
For Each PR In DOC.Paragraphs
Set RN = PR.Range
 
If RN.Information(wdWithInTable) = True Then
S2 = PR.Range.Text
KX = KX + 1
If KX = 1 Then KT = KT + 1
''Debug.Print KT, KX, S1, S2;
MACT(KT, 0) = S1
    With DOC.Tables(KT)
        For J1 = 1 To 7
        MACT(KT, J1) = CleanString(.Rows(J1).Range.Cells(2).Range.Text)
        Next J1
    End With
Else
    S1A = CleanString(PR.Range.ListFormat.ListString & " " & PR.Range.Text)
    
    If Len(S1A) > 5 Then
    S1 = S1A
    Else
    GoTo next_pr
    End If
    With PR.Range.ListFormat
    Debug.Print .ListValue,
    Debug.Print .ListLevelNumber, Len(S1A), S1A;
    End With
    
    KX = 0
    ''Debug.Print S1;
End If
next_pr:
Next PR
'''''''''''''''''''''''''
Exit Sub
'''''''''''''''''''''''''
Dim XL As Object
Set XL = CreateObject("Excel.Application")
XL.Visible = True
With XL.Workbooks.Add.Sheets(1)
    .Cells(1).Resize(10, 8).Value = MACT
    With .UsedRange
        .ColumnWidth = 27
        .Columns(2).ColumnWidth = 72
        .Columns(6).ColumnWidth = 72
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
    End With
End With
Set XL = Nothing
End Sub

Sub ddd()
For x = ActiveDocument.Paragraphs.Count To 1 Step -1
    ActiveDocument.Paragraphs(x).Range.ListFormat.ConvertNumbersToText
Next
End Sub