Sub add_text (find_text as string, textbox As String)

Dim line As Long

Dim x As Double

 

With Selection

 

.Find.Execute find_text

.MoveLeft

 

'запоминаем строку

line = .Information(wdFirstCharacterLineNumber)

'запоминаем расстояние в мм от левого края до курсора

x = .Information(wdHorizontalPositionRelativeToPage)

'пытаемся двигаться вниз

.MoveDown

If line = .Information(wdFirstCharacterLineNumber) Then

    'не сдвинулись - пусто внизу

    'добавляем строку

    .EndKey

    .TypeParagraph

    'табуляция

    .ParagraphFormat.TabStops.Add x

    .TypeText Text:=vbTab + textbox

Else

    'удалось сдвинуться, внизу есть строка

    If Abs(x - .Information(wdHorizontalPositionRelativeToPage)) < 4 Then '4 - примерно половина ширины самого широкого символа ("ж") 12 шрифтом (вообще тута надо-б наверное что-то получше придумать)

        'примерно попали под символ (ширина символов разная, длины в мм точно совпадать не должны я думаю)

        'внизу более длинная строка

        .TypeText Text:=textbox

    Else

        'более короткая, и тогда мы уже в её конце

        'добавляем метку табуляции

        .ParagraphFormat.TabStops.Add x

        .TypeText Text:=vbTab + textbox

    End If

End If

 

End With

 

End Sub

add_text "#1", TextBox1.Text

Dim a as String * 10

 

a = TextBox1.Text

 

Selection.Find.ClearFormatting

With Selection.Find

.Text = "#1"

.Replacement.Text = ""

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

End With

Selection.Find.Execute

Selection.MoveDown Unit:=wdLine, Count:=1

Selection.Text = a