Sub
kapitel()
Dim
kapitel()
Dim
tabkap()
Dim
anzahl
Dim
i
As
Long
Dim
j
As
Long
anzahl = ActiveDocument.Tables.Count
ReDim
kapitel(1, 0)
kapitel(0, 0) = 0
For
Each
kap
In
ActiveDocument.Paragraphs
If
kap.OutlineLevel < 10
And
kap.range.Text <> Chr(13)
Then
kapitel(0, 0) = kapitel(0, 0) + 1
ReDim
Preserve
kapitel(1, kapitel(0, 0))
kapitel(0, kapitel(0, 0)) = kap.range.Text
kapitel(1, kapitel(0, 0)) = kap.range.Start
End
If
Next
kap
If
anzahl > 0
Then
ReDim
tabkap(anzahl)
For
i = 1
To
anzahl
For
j = 1
To
UBound(kapitel, 2)
If
ActiveDocument.Tables(i).range.Start < kapitel(1, 1)
Then
tabkap(i) =
"ohne Kapitel"
Else
If
ActiveDocument.Tables(i).range.Start > kapitel(1, j)
Then
tabkap(i) = kapitel(0, j)
End
If
Next
j
Next
i
End
If
End
Sub