vba 将字符串放入现有标题的单词宏

Question

我正在尝试编写一个带有 find/replace 字符串的宏，然后将其移动到现有标题。原文是这样的：

1.标题 1

ID: abcd

1.1 标题 2

ID: abcd

它应该看起来像：

1.Heading 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 which is the raw text and i want to process it to look like this final。我已经找到了，感谢您如何替换文本，只是我停留在原始版本中。谢谢，我给你喝一两杯啤酒

后期编辑：所以我有 5 种标题格式，1。 Heading 1, 1.1 Heading 2 等到5，下面都有一个ID，每个都有一个具体的编号，但是名字是一样的，ID ASD_PC_AWP_[XXXX]。我只需要摆脱 ID ASD_PC_ 并将 AWP_[xxxx] 放在与标题相同的级别，例如：1.Heading 1 AWP_[ xxxx1] ** , **2。标题 2 AWP_[xxx2]...

Answer 1

对后跟 ID: 的任何段落标记执行通配符查找。

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

您需要为标题样式指定替换文本的样式，因为当您删除标题段落末尾的段落标记时，您也会删除标题段落的样式信息。

您需要对后跟 ID：文本的每个样式标题执行此操作。

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 = " []"
            .MatchWildcards = True
            .Wrap = wdFindContinue
            .Execute Replace:=wdReplaceAll

        End With

    Next

End Sub

Answer 2

尝试：

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

vba 将字符串放入现有标题的单词宏

vba word macro to put a string to an existing Heading

vba

ms-word

word-style