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

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

0 голосов
/ 31 октября 2018

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

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 , который является необработанным текстом, и я хочу обработать его, чтобы он выглядел следующим образом final . Я уже узнал, благодаря вам, как заменить текст, просто я застрял в сырой версии. Спасибо, у меня есть пиво или две

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

Ответы [ 2 ]

0 голосов
/ 01 ноября 2018

Попробуйте: 

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
0 голосов
/ 31 октября 2018

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

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

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

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

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

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

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

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

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
...