Добавление содержимого в конкретную точку текста с использованием 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
Это не работает в любом случае! Что не так с этим?