WordVBA——查找定位+设置嵌套域代码思路讲解

Rem 本视频代码

Sub 域代码嵌套()

  Dim fw As Range

  Dim ks As Long

  Dim js As Long

  Dim ks1 As Long

  Dim js1 As Long

  Dim ks2 As Long

  Dim js2 As Long

  Dim arr()

  Dim ar

  Dim i As Long

  Dim fd As Field

   

  Set fw = Selection.Range

  ks = fw.Start

  js = fw.End + 1

  fw.InsertAfter " "

  fw.SetRange ks, js

   

findLabel:

  With fw.Find

    .ClearFormatting

    .Forward = True

    .Wrap = wdFindStop

    .MatchWildcards = True

    .Text = "\{[!^13\{\}]@\}"

     

    Do While .Execute

      If .Parent.Start >= ks Then

        If .Parent.End <= js Then

          .Parent.Select

          ks1 = .Parent.Start

          js1 = .Parent.End

           

          With .Parent.Find

            .ClearFormatting

            .Wrap = wdFindStop

            .MatchWildcards = True

            .Text = "[\{\}]"

            With .Replacement

              .ClearFormatting

              .Text = "$"

            End With

            .Execute Replace:=wdReplaceAll

          End With

           

           

          ReDim Preserve arr(i)

          arr(i) = Array(ks1, js1)

          i = i + 1

           

          Set fw = fw.Document.Range(ks, js)

          GoTo findLabel

        Else

          Exit Do

        End If

      End If

    Loop

     

    fw.Characters.Last = ""

  End With

   

  If i > 0 Then

    For Each ar In arr

      Set fd = fw.Document.Range.Fields.Add(fw.Document.Range(ar(0), ar(1)), Type:=wdFieldEmpty, preserveformatting:=False)

      With fd

        .ShowCodes = True

        With .Code

          ks2 = .Start + 2

          js2 = .End - 2

          fw.Document.Range(ks2, js2).Cut

          .Select

          Selection.Paste

        End With

      End With

    Next

  End If

     

  fw.Select

  fw.Fields.ToggleShowCodes

   

  Set fw = Nothing

  Set fd = Nothing

End Sub