Есть документ 1 - это мой сценарий. Но из-за специфики производства видеоигр мне приходится реплики отправлять в таблицу (как в документе 2).
К сожалению писать макросы не умею, получается только как в документе 3. Близко, но надо как в документе 2
Сам макрос в 4-ом вложении, но напишу его тут отдельно
Спойлер
Sub ReplaceDialoguesWithTables()
Dim doc As Document
Dim rng As Range, rngDialogue As Range
Dim tbl As Table
Dim nameStyle As String, dialogueStyle As String
Dim nameText As String, dialogueText As String
Set doc = ActiveDocument
nameStyle = "2. ИМЕНА" ' Стиль для имён персонажей
dialogueStyle = "3.РЕПЛИКИ" ' Стиль для реплик (если есть)
' Начинаем с начала документа
Set rng = doc.Content
rng.Collapse wdCollapseStart
' Ищем первое вхождение имени персонажа
With rng.Find
.ClearFormatting
.Style = nameStyle
.Forward = True
.Wrap = wdFindStop
Do While .Execute
' Захватываем имя персонажа
nameText = Trim(rng.text)
Set rngDialogue = rng.Duplicate
rngDialogue.Collapse wdCollapseEnd
rngDialogue.MoveEnd wdParagraph, 1
dialogueText = Trim(rngDialogue.text)
' Создаём таблицу на месте реплики
rng.InsertBefore vbCr & vbCr
rng.MoveStart wdCharacter, -1
Set tbl = doc.Tables.Add(rng, 1, 2)
tbl.Borders.Enable = True
tbl.Cell(1, 1).Range.text = nameText
tbl.Cell(1, 2).Range.text = dialogueText
' Перемещаемся к следующему элементу
rng.Collapse wdCollapseEnd
Loop
End With
MsgBox "Реплики заменены таблицами!", vbInformation
End Sub