Добавление содержимого в конкретную точку текста с использованием vba

У меня есть шаблон документа.docx, который я должен редактировать, добавляя строки в определенных точках. Это выглядит следующим образом:

Тестовый режим: здесь должен быть добавлен некоторый текст, который может занимать больше строк, он должен иметь отступ для каждого из них.
Вовлеченные элементы: здесь необходимо добавить текст...
Параметры ввода и симуляции: здесь нужно добавить текст...

До Kow я использую следующий код

Sub FillingParagraphs()
    Dim SubPara As Paragraph
    Dim SubLevel As String
    SubLevel = "3.1.1.1"
    'Filling each subparagraph
    For k = 1 To 3
        For Each SubPara In ActiveDocument.Paragraphs
            j = j + 1
            If SubPara.Range.ListFormat.ListString = SubLevel Then
                Selection.Start = ActiveDocument.Content.ListString
            ActiveDocument.Paragraphs(j + 2).Range.Words(5) = "Text to be added" & Chr(10)
            MsgBox j
            End If
        Next
        'Update the string with the next subparagraph
            SubLevel = "3.1.1." & CStr(k + 1)
        j = 0
    Next
End Sub

Хотя это работает, мне нужно указать точную точку, с которой начинаем писать, считая слова и абзацы:

ActiveDocument.Paragraphs(j + 2).Range.Words(5)

и этот способ не такой умный, поэтому я бы хотел изменить мой код примерно так:

Selection.Start = ActiveDocument.Content.END_SUBSTRING_1
Selection.TypeParagraph
Selection.TypeText (" Text to be added")

Есть идеи?

2 ответа

Может быть, вам нужно что-то вроде этого:

Sub InsertText(findWhat As String, insertAfter As String)
    With ActiveDocument.Range.Find
        .ClearFormatting
        .Text = findWhat
        .Replacement.ClearFormatting
        .Replacement.Text = findWhat & " " & insertAfter
        .MatchWholeWord = True
        .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindStop
    End With
End Sub

Sub test()
    InsertText "some text to find", "some text to be added"
End Sub

Я попытался изменить процедуру в следующем, где я даю диапазон функции для поиска:

Sub InsertText(findWhat As String, insertAfter As String, MyRange As Range)
    With ActiveDocument.MyRange.Find
        .ClearFormatting
        .Text = findWhat
        .Replacement.ClearFormatting
        .Replacement.Text = findWhat & " " & insertAfter
        .MatchWholeWord = True
        .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindStop
    End With
End Sub

поэтому в другой части кода я определяю диапазон и устанавливаю его со значениями по умолчанию, затем сбрасываю мой диапазон в соответствии с моими потребностями:

Level1 = "3.1.1.1"
Level2 = "3.1.1.2"

'Определить MyRange со значениями по умолчанию

Dim MyRange As Range
Dim StartRange As Integer
Dim EndRange As Integer
Set MyRange = ActiveDocument.Range(0, 0)

Переопределить MyRange

For Each RngPara In ActiveDocument.Paragraphs
        i = i + 1
        If RngPara.Range.ListFormat.ListString = Level1 Then
        StartRange = i
        ElseIf RngPara.Range.ListFormat.ListString = Level2 Then
        EndRange = i
        End If

        MyRange.SetRange     Start:=MyRange.Start,End:=ActiveDocument.Paragraphs(3).Range.End
Next 
InsertText "Scope of test:", Scopo(j), MyRange

Это не работает в любом случае! Что не так с этим?

Другие вопросы по тегам