Sub Nummerieren()
Dim p As Paragraph
With ListGalleries(wdNumberGallery).ListTemplates(1).ListLevels(1)
.NumberFormat = "%1."
.NumberPosition = CentimetersToPoints(0)
.Font.Bold = True
End With
With ActiveDocument.Styles.Add("Hauptnummern", wdStyleTypeParagraph)
.BaseStyle = "Standard"
.NextParagraphStyle = "Standard"
.Font.Bold = True
With .ParagraphFormat
.LeftIndent = CentimetersToPoints(0.63)
.FirstLineIndent = CentimetersToPoints(-0.63)
.SpaceBefore = 25
.SpaceAfter = 0
End With
.LinkToListTemplate ListGalleries(wdNumberGallery).ListTemplates(1), ListLevelNumber:=1
End With
For Each p In ActiveDocument.Paragraphs
If Len(p.Range.Text) = 1 Then
p.Style = "Hauptnummern"
End If
Next p
End Sub