vba word macro для добавления строки в существующий заголовок

Question

Я пытаюсь написать макрос, который с найти / заменить строку, а затем переместить его в существующий заголовок. Исходный текст выглядит так:

1. Заголовок 1

ID: abcd

1.1 Заголовок 2

ID: abcd

И это должно выглядеть так:

1. Заголовок 1 abcd

1.1 Заголовок 2 abcd

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

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Style = "Heading 2"
With Selection.Find
    .Text = "abcd"
    .Replacement.Text = "abcd^p"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = True
    .MatchSoundsLike = False
    .MatchAllWordForms = False

End With
Selection.Find.Execute Replace:=wdReplaceAll

Текст не так важен, потому что мне удалось заменить на то, что я хочу, но я не знаю, как привести его в соответствие со стилем заголовка. Спасибо

РЕДАКТИРОВАТЬ: Я надеюсь, что я не облажался снова, извините большой:). Итак, у меня есть raw, который является необработанным текстом, и я хочу обработать его, чтобы он выглядел как этот финал. Я уже узнал, благодаря вам, как заменить текст, просто я застрял в сырой версии. Спасибо, у меня есть пиво или два

ПОСЛЕДНЕЕ РЕДАКТИРОВАНИЕ: Итак, у меня есть 5 типов форматов заголовков: 1. Заголовок 1, 1.1 Заголовок 2 и т. Д. До 5, и все они имеют ниже идентификатор, каждый с определенным номером, но имя одно и то же, ID ASD_PC_AWP_ [ XXXX]. Мне просто нужно избавиться от идентификатора ASD_PC_ и поставить AWP_[xxxx] на том же уровне заголовка, например: 1.Heading 1 AWP_ [xxxx1] **, ** 2. Заголовок 2 AWP_ [xxx2]...

Answer 1

Пытаться:

Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "ID:*^13"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    Set Rng = .Duplicate.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
    Rng.End = Rng.Paragraphs.First.Range.End - 1
    Rng.InsertAfter Split(Split(.Duplicate.Text, ":")(1), vbCr)(0)
    .Text = vbNullString
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub

Answer 2

Сделайте поиск по шаблону для любого маркера абзаца, за которым следует ID:.

.Text = "^ 13ID:"
.Replacement.Text = ""

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

Вам нужно будет сделать это с каждым заголовком стиля, за которым следует идентификатор: текст.

Обновлено 2018-11-01

Следующий код должен работать. Я получил несколько подсказок от оригинального кода Macropods.

Обновление 2 2018-11-01

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

Sub ConsolidateHeadingWithID()

Const HEADINGS                                   As String = "Heading 1,Heading 2,Heading 3,Heading 4,Heading 5,Other style,another style"

Dim my_headings                                 As Variant
Dim my_heading                                  As Variant
my_headings = Split(HEADINGS, ",")

For Each my_heading In my_headings

        With ActiveDocument.StoryRanges(wdMainTextStory)

            With .Find

                .ClearFormatting
                .format = True
                .Text = ""
                .Style = my_heading
                .MatchWildcards = True
                .Wrap = wdFindStop
                .Execute

            End With

            Do While .Find.Found

                If .Duplicate.Next(unit:=wdWord).Text = "ID" Then

                    .Duplicate.Next(unit:=wdParagraph).Style = my_heading

                End If

                .Collapse wdCollapseEnd
                .MoveStart unit:=wdCharacter, Count:=2
                .Find.Execute

            Loop

        End With

        With ActiveDocument.Range.Find

            .ClearFormatting
            .format = True
            .Text = "(^13)(ID:)(*)(AWP_)([0-9]{1,})"
            .Style = my_heading
            .Replacement.Text = " [\4\5]"
            .MatchWildcards = True
            .Wrap = wdFindContinue
            .Execute Replace:=wdReplaceAll

        End With

    Next

End Sub