Sub Макрос1()
Dim Numrange As Range
Dim numtable As Table
Dim numcolumn As Column
Dim tabwidth As Long
Dim i As Long
  Set Numrange = Selection.Range
  Set numtable = Numrange.ConvertToTable(Separator:=vbCr)
  tabwidth = PointsToInches(numtable.Columns(1).Width)
  Set numcolumn = Numrange.Tables(1).Columns.Add(BeforeColumn:=numtable.Columns(1))
  numcolumn.Width = InchesToPoints(0.5)
  numtable.Columns(2).Width = InchesToPoints(tabwidth - 0.5)
  For i = 1 To numcolumn.Cells.Count
    numcolumn.Cells(i).Range.InsertBefore (numcolumn.Cells.Count - i + 1) & "."
  Next i
  numtable.Borders.Enable = False
lbl_Exit:
  Exit Sub
End Sub
Sub Макрос()
  Dim i As Long
Dim listCount As Long
Dim Numrange As Range
Dim oTmpRng As Range
  Set Numrange = Selection.Range
  ActiveWindow.View.ShowFieldCodes = False
  Numrange.ParagraphFormat.TabStops.Add Position:=InchesToPoints(0.3)
  listCount = Numrange.Paragraphs.Count
  For i = 1 To listCount
    Set oTmpRng = Numrange.Paragraphs(i).Range
    If IsNumeric(oTmpRng.Characters(1)) Then
      On Error GoTo ErrHandler
      If InStr(oTmpRng.Fields(1).Code, "SEQ") > 0 Then
        oTmpRng.Fields(1).Delete
        oTmpRng.End = oTmpRng.Start + 2
        oTmpRng.Delete
      End If
    End If
Reentry:
    Set oTmpRng = Numrange.Paragraphs(i).Range
    oTmpRng.Collapse wdCollapseStart
    oTmpRng.InsertAfter "." & vbTab
    oTmpRng.End = oTmpRng.End - 2
    If i = 1 Then
      Numrange.Fields.Add oTmpRng, wdFieldSequence, "ReverseList \r1", False
    Else
      Numrange.Fields.Add oTmpRng, wdFieldSequence, "ReverseList", False
    End If
    oTmpRng.End = oTmpRng.End + 1
    Numrange.Fields.Add oTmpRng, wdFieldEmpty, , False
    oTmpRng.End = oTmpRng.End - 1
    oTmpRng.InsertAfter Text:="=" & listCount + 1 & "-"
    With Numrange.Paragraphs(i)
      .LeftIndent = InchesToPoints(0.3)
      .FirstLineIndent = InchesToPoints(-0.3)
    End With
  Next i
  ActiveWindow.View.ShowFieldCodes = False
  ActiveDocument.Fields.Update
  Exit Sub
ErrHandler:
  If Err.Number = 5941 Then
    Set oTmpRng = Nothing
    Resume Reentry
  Else
    MsgBox "Unknown error exiting this routine"
  End If
End Sub

Private Sub CommandButton1_Click()
    Set Table = Range.Tables(1)
    countColumn = Table.Columns.Count
    countRow = Table.Rows.Count
    For i = 2 To countRow
    Table.Cell(i, 1) = countRow - i + 1
    Next i
End Sub

'Private Sub ComboBox1_Change()
'End Sub
'Private Sub ComboBox1_Click()
''Set bm = ActiveDocument.Bookmarks
''ComboBox1.RowSource = bm("таблиця").Range
'End Sub
'Private Sub ComboBox1_Enter()
'ComboBox1.AddItem "175"
'ComboBox1.AddItem "Left Top"
'ComboBox1.AddItem "210"
'End Sub
'Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'End Sub
Private Sub Label1_Click()
МаркаПроводу.Value = "АС-50"
End Sub
Private Sub Label12_Click()
tbDate.Text = ""
End Sub

Private Sub Label6_Click()
ДопустСтрум.Text = 210
End Sub

Private Sub ListBox1_Click()

End Sub

Private Sub tbDate_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
tbDate.Text = Format(Date, "dd mm yyyy")
End Sub

Private Sub tbDate_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsDate(tbDate.Text) Then 'если данные введены не в формате даты, то
    MsgBox "Дата введена неправильна або без дати"   'выводим сообщение
    '        Exit Sub
End If
End Sub

Private Sub ВставитиДані_Click()
'Дії форми при натиску кнопки "ВставитиДані"
Dim bm As Bookmarks
Dim rng As Word.Range
Dim addr As String
Dim sText As String
Dim sResult1 As String
Dim sResult2 As String
Dim arName() As String  'объявляем динамический массив из строки "Имя адресата"

Set bm = ActiveDocument.Bookmarks
'Дії з полями
With tbDate
MyPos = InStr(1, (.Text), "р")    ' Returns 0 коли нема "р".
    If (.Text) = "" Then
    Set rng = bm("дата5").Range
    rng.Text = "____________"
    bm.Add "дата5", rng
    End If
        Set rng = bm("дата5").Range 'присваиваем переменной rng ссылку на закладку "дата5"
        If MyPos = 0 Then
            rng.Text = tbDate & " р."    ' текст закладки з "р".
            Else
            rng.Text = tbDate   ' текст закладки без "р".
        End If
        bm.Add "дата5", rng 'вставляєм текст в закладку
End With
    Set rng = bm("ДозволенаПотужність5").Range
    rng.Text = МаксРозрахНавант
    bm.Add "ДозволенаПотужність5", rng
Set rng = bm("обєкт5").Range
rng.Text = ОбєктАдресЗаявник
bm.Add "обєкт5", rng
    Set rng = bm("провід5").Range
    rng.Text = МаркаПроводу
    bm.Add "провід5", rng
Set rng = bm("точкаЗабезп5").Range
rng.Text = ТочкаЗабезп
bm.Add "точкаЗабезп5", rng
    Set rng = bm("напруга5").Range
    rng.Text = Напруга
    bm.Add "напруга5", rng
Set rng = bm("СтрумПровода5").Range
rng.Text = ДопустСтрум
bm.Add "СтрумПровода5", rng
    Set rng = bm("ПС_110або35").Range
    rng.Text = Підстанція
    bm.Add "ПС_110або35", rng
Set rng = bm("ПотужнПоДогов5").Range
rng.Text = ПотужнПоДогов
bm.Add "ПотужнПоДогов5", rng
    Set rng = bm("фідер5").Range
    rng.Text = НомерФідера
    bm.Add "фідер5", rng
Set rng = bm("МаксимальнеНавантаження5").Range
rng.Text = МаксНавантОЗП
bm.Add "МаксимальнеНавантаження5", rng
    Set rng = bm("Заявник5").Range
    rng.Text = Заявник
    bm.Add "Заявник5", rng
Set rng = bm("резервПотужн5").Range
rng.Text = РезервПотужн
bm.Add "резервПотужн5", rng

'Set rng = bm("name").Range 'присваиваем переменной rng ссылку на закладку "name"
'sResult1 = arName(0) & " " 'присваиваем переменной значение первого слова из поля "Имя адресата" и _
'                            добавляем пробел
'sResult1 = sResult1 & Left(arName(1), 1) & ". " 'добавляем к первому слову первую букву Имени и точку
'sResult1 = sResult1 & Left(arName(2), 1) & "."  'добавляем первую букву Отчества и точку
'rng.Text = sResult1  'определяем новый текст закладки
'bm.Add "name", rng   'заменяем закладку
Unload Me   'Закрываем форму
    Selection.WholeStory ' Виділити все
ActiveDocument.Range.Fields.Update  'Обновляем все поля в документе
Selection.HomeKey Unit:=wdStory
End Sub

Private Sub CommandButton2_Click()
'Выход из формы и закрытие окна документа при нажатии кнопки "Отменить"
On Error GoTo ErrLabel
Unload Me    'Закрываем форму
'ActiveDocument.Close  'Закрываем текущий документ
ErrLabel:
End Sub

Private Sub TextBox2_Change()
'Устанавливаем правила заполнения поля "Индекс"
With tbIndex
   If Not IsNumeric(.Text) Or Len(.Text) <> 6 Then 'если в поле "Индекс" данные не цифры и меньше 6, то
      MsgBox "Ошибка!" & " " & "Введите 6 цифр индекса города или района." 'выводим сообщение
      Cancel = True  'возвращаемся к полю
      .Text = ""  'очищаем поле
      .SetFocus
   End If
End With
End Sub
Private Sub tbName_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'При выходе из поля "Имя адресата" его имя подставляется в поле "Приветствие"

sText = tbName.Text
arName = Split(sText)
'sResult2 = arName(1) & " "
'sResult2 = sResult2 & arName(2)

tbSalutation = "Уважаемый " & sResult2 & "!"

End Sub
Private Sub UserForm_Initialize()
Set bm = ActiveDocument.Bookmarks
ОбєктАдресЗаявник = bm("обєкт5").Range
МаксРозрахНавант = bm("ДозволенаПотужність5").Range
МаркаПроводу = bm("провід5").Range
ТочкаЗабезп = bm("точкаЗабезп5").Range
Напруга = bm("напруга5").Range
ДопустСтрум = bm("СтрумПровода5").Range
Підстанція = bm("ПС_110або35").Range
ПотужнПоДогов = bm("ПотужнПоДогов5").Range
НомерФідера = bm("фідер5").Range
МаксНавантОЗП = bm("МаксимальнеНавантаження5").Range
Заявник = bm("Заявник5").Range
tbDate = bm("дата5").Range
РезервПотужн = bm("резервПотужн5").Range
End Sub
Private Sub UserForm_Click()

End Sub
Private Sub МаксНавантПЛ_Change()

End Sub

Private Sub ДопустСтрум_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
End Sub

Private Sub Заявник_Change()

End Sub

Private Sub МаксРозрахНавант_Change()

End Sub
Private Sub МаркаПроводу_Change()
МаркаПроводу.List = Array("АС-35", "АС-50", "А-35", "А-50")
Number = МаркаПроводу.ListIndex
B = МаркаПроводу.List(Number)
Select Case Number
Case 0
ДопустСтрум.Text = 175
Case 1
ДопустСтрум.Text = 210
Case 2
ДопустСтрум.Text = 170
Case 3
ДопустСтрум.Text = 215
End Select
End Sub

Private Sub МаркаПроводу_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
МаркаПроводу.Value = "АС-35"
End Sub

Private Sub МаркаПроводу_Enter()

End Sub

Private Sub напруга_Change()
НомерФідера = Напруга.Value & " кВ №"
End Sub

Private Sub НомерФідера_Change()

End Sub
Private Sub Підстанція_Change()
Підстанція.List = Array("ПС 110/35/10 кВ ''Хххххх''", "ПС 110/35/10 кВ ''Еееее''", "ПС 35/10 кВ ''Іііі''", _
"ПС 35/10 кВ ''Ввввв''", "ПС 35/10 кВ ''Ооооо''", "ПС 35/10 кВ ''Оріховець''", "ПС 35/10 кВ ''Рррррр''", _
"ПС 35/10 кВ ''Ааааа''", "ПС 35/10 кВ ''Ссссс''")
End Sub

Private Sub ПотужнПоДогов_Change()

End Sub

Private Sub ТочкаЗабезп_Change()

End Sub