Выровнять текст по ширине пробелами

Sub m_1()
'Удаляем лишние пробелы
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = " {2;}"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
'Ставим в конце каждой Строки знак абзаца
    Dim vLineCount As Long
    Dim vСчётчик As Long
    vLineCount = ActiveDocument.ComputeStatistics(wdStatisticLines)
    Selection.HomeKey unit:=wdStory
    For vСчётчик = 1 To vLineCount
        Selection.EndKey unit:=wdLine
        If Selection.Text <> Chr(13) Then
            Selection.TypeParagraph
        Else
            Selection.HomeKey unit:=wdLine, Extend:=wdExtend
            Selection.Font.Animation = wdAnimationMarchingRedAnts
            Selection.MoveDown
        End If
    Next
    vLineCount = Empty
    vСчётчик = Empty
'Удаляем пробел в конце каждой Строки
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = " ^p"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
'Вставляем пробелы, чтобы расстянуть текст
    Dim oParagraph As Paragraph
metka:
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        While .Execute
            If Selection.Paragraphs(1).Range.Characters.Count < 66 And Selection.Paragraphs(1).Range.Font.Animation = wdAnimationNone Then
                Selection.TypeText "  "
            End If
        Wend
    End With
    For Each oParagraph In ActiveDocument.Paragraphs
        If oParagraph.Range.Characters.Count < 66 And oParagraph.Range.Font.Animation = wdAnimationNone Then
            GoTo metka
        End If
    Next
    ActiveDocument.Range.Font.Animation = wdAnimationNone
End Sub