简体   繁体   中英

Macro to Replace Pronouns with Conditional Merge Field

I need a macro that replaces his/her or he/she with a conditional merge field. Thanks to another website, I was able to replace these pronouns with a merge field, but not a conditional merge field without crashing MS Word. Below is the code that I used.

  Sub TestAddIf()

    Dim doc As Word.Document
    Dim mRng As Range
    Set doc = ActiveDocument
    Set mRng = ActiveDocument.Range
    With oRng.Find
      Do While .Execute(FindText:="he")
        doc.MailMerge.Fields.AddIf mRng, _
        MERGEFIELD:="""Client_Sex""", Comparison:=wdMergeIfEqual, CompareTo:="M", _
        truetext:="he", _
        falsetext:="she"
        mRng.Collapse wdCollapseEnd
        Loop
    End With
End Sub

Try the following macro, which deals with 'he', 'his', 'him', and 'male' throughout the document (delete the ',male' & ',female' terms if you don't want them).

Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range, RngFld As Range, StrFnd As String, StrRep As String, StrCode As String, i As Long, j As Long
StrM = "he,his,him,male": StrF = "she,her,her,female"
With ActiveDocument
  For i = 0 To UBound(Split(StrM, ","))
    StrCode = "IFX= ""M"" """ & Split(StrM, ",")(i) & """ """ & Split(StrF, ",")(i) & """"
    j = Len(StrCode) + 4
    Set Rng = .Range(0, 0)
    .Fields.Add Range:=Rng, Type:=wdFieldEmpty, Text:=StrCode, PreserveFormatting:=False
    Rng.End = Rng.End + j
    .Fields.Add Range:=Rng.Characters(5), Type:=wdFieldEmpty, Text:="MERGEFIELD Client_Sex", PreserveFormatting:=False
    Rng.Cut
    With .Range.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Wrap = wdFindContinue
      .MatchCase = False
      .MatchWholeWord = True
      .MatchWildcards = False
      .Text = Split(StrM, ",")(i)
      .Replacement.Text = "^c"
      .Execute Replace:=wdReplaceAll
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM