MS Word VBA - заменить текст на соответствующее поле слияния - PullRequest
Новая
       97

MS Word VBA - заменить текст на соответствующее поле слияния

0 голосов
/ 01 мая 2018

Я хотел бы создать макрос в MS Word, который при запуске ищет в документе текст, который появляется в теле документа и соответствует имени поля слияния. После идентификации это изменит текст в документе на фактическое совпадающее имя поля слияния. Например, если было поле слияния с именем «project_date» и в документе Word был текст «project_date», то макрос превратил бы текст в фактическое поле слияния «project_date». В идеале макрос должен делать это для всех полей слияния, которые существуют одновременно.

Ниже приведено описание моего желаемого кода.

Я нашел этот код здесь (https://answers.microsoft.com/en-us/msoffice/forum/msoffice_word-mso_other-mso_2007/how-do-i-replace-words-in-a-document-with-a-mail/da323980-7c7d-e011-9b4b-68b599b31bf5), но он будет выполнять только одно указанное поле слияния за один раз. 

Dim oRng As Range
Set oRng = ActiveDocument.Range
With oRng.Find
    Do While .Execute(FindText:="(Player 1)")
        oRng.Fields.Add oRng, wdFieldMergeField, "Player_1", False
        oRng.Collapse wdCollapseEnd
    Loop
End With

Я записал это сам, но не уверен, как искать и заменять текст нужным полем слияния. 

With Selection.Find
        .Text = "project_name"
        .Replacement.Text = "project_name"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

1 Ответ

0 голосов
/ 03 мая 2018

Решение для этого объединяет код для вставки всех полей слияния в документ с базовым кодом, который вы нашли / записали. Вставка поля слияния перемещается в функцию, которая ищет имена полей в документе. Я установил функцию, чтобы она возвращала количество раз, когда поле вставлено.

Сложной или особенной частью функции является настройка диапазона после успешного поиска, чтобы продолжить поиск. Конечная точка поля слияния все еще находится в поле слияния, поэтому после сворачивания диапазона требуется линия oRng.MoveStart wdCharacter, 2. Если Range остается в пределах поля, имя поля слияния внутри него будет найдено снова, и снова, и снова ... 

Sub InsertAllMergeFieldsAtPlaceholders()
    Dim doc As word.Document
    Dim rng As word.Range
    Dim mm As word.MailMergeDataField

    Set doc = ActiveDocument
    Set rng = doc.content
    If doc.MailMerge.MainDocumentType <> wdNotAMergeDocument Then
        For Each mm In doc.MailMerge.DataSource.DataFields
            Debug.Print ReplaceTextWithMergeField(mm.NAME, rng) & " merge fields inserted for " & mm.NAME
            Set rng = doc.content
        Next
    End If
End Sub

Function ReplaceTextWithMergeField(sFieldName As String, _
                                   ByRef oRng As word.Range) As Long
    Dim iFieldCounter As Long
    Dim fldMerge As word.Field
    Dim bFound As Boolean

    With oRng.Find
        .ClearFormatting
        .Forward = True
        .wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        bFound = .Execute(findText:=sFieldName)
    End With
    Do While bFound
        iFieldCounter = iFieldCounter + 1
        Set fldMerge = oRng.Fields.Add(oRng, wdFieldMergeField, sFieldName, False)
        Set oRng = fldMerge.result
        oRng.Collapse wdCollapseEnd
        oRng.MoveStart wdCharacter, 2
        oRng.End = oRng.Document.content.End
        bFound = oRng.Find.Execute(findText:=sFieldName)
    Loop
    ReplaceTextWithMergeField = iFieldCounter
End Function
...