vba word 宏将字符串放入现有标题

Question

i am attempting to write a macro that with find/replace a string and than move it to an existing heading. The original text is like this:

1. Heading 1

ID : abcd

1.1 Heading 2

ID : abcd

And it should look like:

1.Heading 1 abcd

1.1 Heading 2 abcd

I am having some problems with the code i tried to write, mostly because i am kinda new, but this is what i created so far:

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

The text is not so important because i managed to replace with what i want but i don't know how to align it with the Heading style.. Thanks

EDIT: I hope i don't screw up again, sorry big :). So i have raw which is the raw text and i want to process it to look like this final . I already found out, thanks to you how to replace the text, it's just that i stuck in the raw version. Thanks, I kinda own you a beer, or two

LATER EDIT: So i have 5 types of Heading formats, 1. Heading 1, 1.1 Heading 2 etc till 5, and all of them have below them an ID, each with a specific number, but the name is the same, ID ASD_PC_AWP_[XXXX]. I just have to get rid of ID ASD_PC_ and put AWP_[xxxx] at same level of the Heading eg: 1.Heading 1 AWP_[xxxx1] ** , **2. Heading 2 AWP_[xxx2] ...

Answer 1

Do a wildcard find for any paragraph marker which is followed by ID:.

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

You will need to specify the style of the replacement text to the heading style because when you delete the paragraph marker at the end of the Heading paragraph you will also delete the style information for the heading paragraph.

You will need to do this with every style heading followed by the ID: text.

Updated 2018-11-01

The following code should work. I got some hints from Macropods ingeneous code.

Update 2 2018-11-01

Revised to work with a list of styles defined by user at OPs request

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

Answer 2

Try:

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