Dim ObjectWord As Object
    Set ObjectWord = GetObject(, " Word.Application")
 
    'отключаем дёргание экрана при выполнении кода
    ObjectWord.Application.ScreenUpdating = False
 
    '************************
    Dim isTable As ObjectWord.Range
    Set isTable = Selection.Range

'защищает от некоторых, трудно уловимых ошибок
'Option - Вариант
'Explicit - Явный
Option Explicit
 
Sub Main()
 
'отключаем дёргание экрана при выполнении кода
Application.ScreenUpdating = False
 
'*********************************************************
'функция (выясняем место нахождения курсора в таблице)
Dim isTable As Word.Range
Set isTable = Selection.Range
 
'условие, если выделено более одной таблицы, тогда ...
If Selection.Tables.Count > 1 Then
MsgBox$ _
                "Программа не может быть продолжена, выделено более одной таблицы", vbOKOnly, _
                "Внимание"
GoTo Конец
'условие, если выделеное находится не в таблице, тогда ...
ElseIf Not isTable.Information(wdWithInTable) Then
MsgBox$ _
                "Программа не может быть продолжена, курсор должен находится в таблице", vbOKOnly, _
                "Внимание"
GoTo Конец
End If
 
'номер таблицы в документе, где расположен курсор
Dim NumberCursorTable As Long
'номер таблицы в документе, где расположен курсор
NumberCursorTable = ActiveDocument.Range(0, Selection.Tables(1).Range.End).Tables.Count
 
'номер строки в таблице, в документе, где расположен курсор
Dim NumberCursorRow As Long
'номер строки в таблице, в документе, где расположен курсор, даже если таблица имеет объединённые ячейки
NumberCursorRow = Selection.Information(wdEndOfRangeRowNumber)
 
'номер столбца, а также ячейки в таблице, в документе, где расположен курсор, даже если ширина столбца, ячейки различается
Dim NumberCursorCell As Long
'номер столбца, то есть ячейки в строке таблицы, в документе где расположен курсор, даже если таблица имеет объединённые ячейки
NumberCursorCell = Selection.Information(wdEndOfRangeColumnNumber)
 
'*********
'2 вариант
 
'номер строки в таблице, в документе, где расположен курсор, даже если таблица имеет объединённые  ячейки
'IntegerCursorRow = Selection.Cells(1).RowIndex
 
'номер столбца, а также ячейки в таблице, в документе, где расположен курсор, даже если ширина столбца, ячейки различается
'IntegerCursorCell = Selection.Cells(1).ColumnIndex
'*********
 
'установка объекта в значение Nothing требуется для освобождения памяти, которая была выделена для создания этого объекта
Set isTable = Nothing
'конец функции (выясняем место нахождения курсора в таблице)
'*********************************************************
    
Selection.Delete Unit:=wdCharacter, Count:=1
 
Dim Строка_таблицы_Word As String
 
'************************************************************************
'функция (считывание со строки, ячейки таблицы)
'Range со строки или ячейки таблицы Word
'абзац заменяем на пробел
'заменяем два, три, четыре и более пробелов подряд на один пробел
'удаляем концевую сноску таблицы Word
'заменяем пробел, следом идущую запятую на запятую, то есть, удаляем пробел перед запятой
'заменяем двоеточие, следом идущее двоеточие на двоеточие, то есть удаляем пробел перед двоеточием
 
'здесь при помощи Trim$ откидываем лишние пробелы в начале и в конце строки или ячейки таблицы Word
Строка_таблицы_Word = Trim$(ActiveDocument.Tables(NumberCursorTable).Rows(NumberCursorRow).Cells(NumberCursorCell).Range)
'Debug.Print Строка_таблицы_Word
 
Dim reg As Object
Set reg = CreateObject("vbscript.regexp")
'искать по всему тексту, по умолчанию False - будет найдено только первое совпадение
reg.Global = True
'Chr$(13) это абзац, заменяем его на пробел
reg.Pattern = Chr$(13)
Строка_таблицы_Word = reg.Replace$(Строка_таблицы_Word, " ")
'Debug.Print Строка_таблицы_Word
'+ означает, что заменяем два, три, четыре и более пробелов подряд на один пробел
reg.Pattern = " +"
Строка_таблицы_Word = reg.Replace$(Строка_таблицы_Word, " ")
'Debug.Print Строка_таблицы_Word
'Chr$(7) это концевая сноска таблицы Word
reg.Pattern = Chr$(7)
Строка_таблицы_Word = reg.Replace$(Строка_таблицы_Word, "")
'Debug.Print Строка_таблицы_Word
'заменяем пробел, следом идущую запятую на запятую, то есть удаляем пробел перед запятой
reg.Pattern = " ,"
Строка_таблицы_Word = reg.Replace$(Строка_таблицы_Word, ",")
'Debug.Print Строка_таблицы_Word
'заменяем пробел, следом идущее двоеточие на двоеточие, то есть удаляем пробел перед двоеточием
reg.Pattern = " :"
Строка_таблицы_Word = reg.Replace$(Строка_таблицы_Word, ":")
'Debug.Print Строка_таблицы_Word
Строка_таблицы_Word = Trim$(Строка_таблицы_Word)
'Debug.Print Строка_таблицы_Word
 
'установка объекта в значение Nothing требуется для освобождения памяти, которая была выделена для создания этого объекта
Set reg = Nothing
'конец функции (считывание со строки, ячейки таблицы)
'************************************************************************
 
With ActiveDocument.Tables(NumberCursorTable)
 
'добавить одну строчку в таблице ниже строки где находится курсор
Selection.InsertRowsBelow 1
 
If .Rows(NumberCursorRow).Cells(NumberCursorCell).Range.Fields.Count = 1 And _
.Rows(NumberCursorRow).Cells(NumberCursorCell).Range.Fields(1).Type = 70 Then
.Rows(NumberCursorRow + 1).Cells(NumberCursorCell).Range.Text = "Место регистрации: " & .Rows(NumberCursorRow).Cells(NumberCursorCell).Range.Fields(1).Result
Else
.Rows(NumberCursorRow + 1).Cells(NumberCursorCell).Range.Text = "Место регистрации: "
End If
 
.Rows(NumberCursorRow).Cells(NumberCursorCell).Range.Text = Строка_таблицы_Word
 
'переместить курсор в конец строки
Selection.EndKey Unit:=wdLine
End With
 
Beep
 
Конец:
 
'отменяем отключенное ранее дёргание экрана при выполнении кода
Application.ScreenUpdating = True
 
End Sub

Dim ObjectWord As Object
Set ObjectWord = GetObject(, " Word.Application")

Dim ObjectWord As Object
Set ObjectWord = GetObject(, " Word.Application")

'защищает от некоторых, трудно уловимых ошибок
'Option - Вариант
'Explicit - Явный
Option Explicit
 
Sub Main()

Dim ObjectWord As Object
Set ObjectWord = GetObject(, " Word.Application")

'отключаем дёргание экрана при выполнении кода
ObjectWord.ScreenUpdating = False
 
'*********************************************************
'функция (выясняем место нахождения курсора в таблице)
Dim isTable As Object
Set isTable = ObjectWord.Selection.Range
 
'условие, если выделено более одной таблицы, тогда ...
If ObjectWord.Selection.Tables.Count > 1 Then
MsgBox$ _
                "Программа не может быть продолжена, выделено более одной таблицы", vbOKOnly, _
                "Внимание"
GoTo Конец
'условие, если выделеное находится не в таблице, тогда ...
ElseIf Not isTable.Information(wdWithInTable) Then

Sub Ссылка()

Shell ("J:\MACROBUTTON'ы\MACROBUTTON1.exe")

End Sub

Set ObjectWord = GetObject(, " Word.Application")

'защищает от некоторых, трудно уловимых ошибок
'Option - Вариант
'Explicit - Явный
Option Explicit

'в VBA нажимаем F2, выясняем чему равно значение констант
Const wdCharacter = 1
Const wdLine = 5
'

Sub Main()

    Dim ObjectWord As Object
    Set ObjectWord = GetObject(, "Word.Application")

    'отключаем дёргание экрана при выполнении кода
    ObjectWord.ScreenUpdating = False

    '*********************************************************
    'функция (выясняем место нахождения курсора в таблице)

    'в VBA нажимаем F2, выясняем чему равно значение констант
    Const wdWithInTable = 12
    Const wdEndOfRangeRowNumber = 14
    Const wdEndOfRangeColumnNumber = 17

    Dim isTable As Object
    Set isTable = ObjectWord.Selection.Range

    'условие, если выделено более одной таблицы, тогда ...
    If ObjectWord.Selection.Tables.Count > 1 Then
        MsgBox$ _
                "Программа не может быть продолжена, выделено более одной таблицы", vbOKOnly, _
                "Внимание"
        GoTo Конец
        'условие, если выделеное находится не в таблице, тогда ...
    ElseIf Not isTable.Information(wdWithInTable) Then
        MsgBox$ _
                "Программа не может быть продолжена, курсор должен находится в таблице", vbOKOnly, _
                "Внимание"
        GoTo Конец
    End If

    'номер таблицы в документе, где расположен курсор
    Dim NumberCursorTable As Long
    'номер таблицы в документе, где расположен курсор
    NumberCursorTable = ObjectWord.Range(0, ObjectWord.Selection.Tables(1).Range.End).Tables.Count

    'номер строки в таблице, в документе, где расположен курсор
    Dim NumberCursorRow As Long
    'номер строки в таблице, в документе, где расположен курсор, даже если таблица имеет объединённые ячейки
    NumberCursorRow = ObjectWord.Selection.Information(wdEndOfRangeRowNumber)

    'номер столбца, а также ячейки в таблице, в документе, где расположен курсор, даже если ширина столбца, ячейки различается
    Dim NumberCursorCell As Long
    'номер столбца, то есть ячейки в строке таблицы, в документе где расположен курсор, даже если таблица имеет объединённые ячейки
    NumberCursorCell = ObjectWord.Selection.Information(wdEndOfRangeColumnNumber)

    '*********
    '2 вариант

    'номер строки в таблице, в документе, где расположен курсор, даже если таблица имеет объединённые  ячейки
    'IntegerCursorRow = Selection.Cells(1).RowIndex

    'номер столбца, а также ячейки в таблице, в документе, где расположен курсор, даже если ширина столбца, ячейки различается
    'IntegerCursorCell = Selection.Cells(1).ColumnIndex
    '*********

    'установка объекта в значение Nothing требуется для освобождения памяти, которая была выделена для создания этого объекта
    Set isTable = Nothing
    'конец функции (выясняем место нахождения курсора в таблице)
    '*********************************************************

    ObjectWord.Selection.Delete Unit:=wdCharacter, Count:=1

    Dim StrokaInVbscriptRegexp As String
    'здесь при помощи Trim$ откидываем лишние пробелы в начале и в конце строки или ячейки таблицы Word
    StrokaInVbscriptRegexp = Trim$(ObjectWord.Tables(NumberCursorTable).Rows(NumberCursorRow).Cells(NumberCursorCell).Range)
    'Debug.Print StrokaInVbscriptRegexp

    'выполнить функцию с именем ...
    FunctionStrokaInVbscriptRegexp StrokaInVbscriptRegexp

    With ObjectWord.Tables(NumberCursorTable)
        'записать данные ... в ячейку таблицы
        .Rows(NumberCursorRow).Cells(NumberCursorCell).Range.Text = StrokaInVbscriptRegexp
        'добавить одну строчку в таблице ниже строки где находится курсор
        ObjectWord.Selection.InsertRowsBelow 1

        'условие, если в ячейке таблицы имеется поле и оно текстовое поле, имеет тип № 70, тогда ...
        If .Rows(NumberCursorRow).Cells(NumberCursorCell).Range.Fields.Count = 1 And _
           .Rows(NumberCursorRow).Cells(NumberCursorCell).Range.Fields(1).Type = 70 Then
            'здесь при помощи Trim$ откидываем лишние пробелы в начале и в конце строки или ячейки таблицы Word
            StrokaInVbscriptRegexp = .Rows(NumberCursorRow).Cells(NumberCursorCell).Range.Fields(1).Result

            'выполнить функцию с именем ...
            FunctionStrokaInVbscriptRegexp StrokaInVbscriptRegexp

            .Rows(NumberCursorRow + 1).Cells(NumberCursorCell).Range.Text = "Место регистрации: " & StrokaInVbscriptRegexp
        Else
            .Rows(NumberCursorRow + 1).Cells(NumberCursorCell).Range.Text = "Место регистрации: "
        End If

        'переместить курсор в конец строки
        ObjectWord.Selection.EndKey Unit:=wdLine
    End With

    Beep

Конец:

    'отменяем отключенное ранее дёргание экрана при выполнении кода
    ObjectWord.ScreenUpdating = True

End Sub

Function FunctionStrokaInVbscriptRegexp(StrokaInVbscriptRegexp)

'************************************************************************
'функция (считывание со строки, ячейки таблицы)
'Range со строки или ячейки таблицы Word
'абзац заменяем на пробел
'заменяем два, три, четыре и более пробелов подряд на один пробел
'удаляем концевую сноску таблицы Word
'заменяем пробел, следом идущую запятую на запятую, то есть, удаляем пробел перед запятой
'заменяем двоеточие, следом идущее двоеточие на двоеточие, то есть удаляем пробел перед двоеточием

    Dim reg As Object
    Set reg = CreateObject("vbscript.regexp")
    'искать по всему тексту, по умолчанию False - будет найдено только первое совпадение
    reg.Global = True
    'Chr$(13) это абзац, заменяем его на пробел
    reg.Pattern = Chr$(13)
    StrokaInVbscriptRegexp = reg.Replace$(StrokaInVbscriptRegexp, " ")
    'Debug.Print StrokaInVbscriptRegexp
    '+ означает, что заменяем два, три, четыре и более пробелов подряд на один пробел
    reg.Pattern = " +"
    StrokaInVbscriptRegexp = reg.Replace$(StrokaInVbscriptRegexp, " ")
    'Debug.Print StrokaInVbscriptRegexp
    'Chr$(7) это концевая сноска таблицы Word
    reg.Pattern = Chr$(7)
    StrokaInVbscriptRegexp = reg.Replace$(StrokaInVbscriptRegexp, "")
    'Debug.Print StrokaInVbscriptRegexp
    'заменяем пробел, следом идущую запятую на запятую, то есть удаляем пробел перед запятой
    reg.Pattern = " ,"
    StrokaInVbscriptRegexp = reg.Replace$(StrokaInVbscriptRegexp, ",")
    'Debug.Print StrokaInVbscriptRegexp
    'заменяем пробел, следом идущее двоеточие на двоеточие, то есть удаляем пробел перед двоеточием
    reg.Pattern = " :"
    StrokaInVbscriptRegexp = reg.Replace$(StrokaInVbscriptRegexp, ":")
    'Debug.Print StrokaInVbscriptRegexp
    StrokaInVbscriptRegexp = Trim$(StrokaInVbscriptRegexp)
    'Debug.Print StrokaInVbscriptRegexp

    'установка объекта в значение Nothing требуется для освобождения памяти, которая была выделена для создания этого объекта
    Set reg = Nothing
    'конец функции (считывание со строки, ячейки таблицы)
    '***********************************************************************

End Function

 NumberCursorTable = ObjectWord.Range(0, ObjectWord.Selection.Tables(1).Range.End).Tables.Count

 Shell "D:\РабочаяПапка\MACROBUTTON1.exe", vbNormalFocus