Как перебрать и заменить совпадения VBA RegExp (или их части) в наборе документов Word, содержащем ячейки таблицы? - PullRequest
Новая
       20

Как перебрать и заменить совпадения VBA RegExp (или их части) в наборе документов Word, содержащем ячейки таблицы?

0 голосов
/ 28 августа 2018

Я использую следующий макрос VBA, чтобы заменить числовую часть фразы «иск <#>», например, на «5. Устройство по п.4, дополнительно содержащее…», с обновленной перекрестной ссылкой на упомянутый абзац претензии, так что если я вставлю куда-нибудь претензию (со стилем абзаца с нумерованным списком) и изменения нумерации, мне не придется вручную обновлять все затронутые ссылки на претензии по одной.

Он работал должным образом, но я обнаружил, что если в выборе есть таблица, я получаю сообщение об ошибке «Ошибка времени выполнения« 4198 »: команда не выполнена», и отладчик выделяет жирную строку для вставки перекрестная ссылка. Если бы мне пришлось угадывать, границы ячеек, по-видимому, увеличивают значение m.FirstIndex (связанного с расположением курсора начала совпадения) на TWO, тогда как метод Selection.MoveStart, кажется, не считает границы ячеек как имеющие ширина символа вообще, поэтому перемещение курсора в m.FirstIndex фактически ставит его на два пробела справа от начала совпадения. Я полагаю, что это может иметь место, потому что на одном из моих тестовых прогонов появилась правильная перекрестная ссылка, но вместо того, чтобы заменить простой текст «1» на «пункт 1», он заменил символ в начале следующей ячейки (но не первый персонаж - ВТОРОЙ персонаж!). Однако я не уверен, почему это вызывает ошибку «сбой команды», так как команда вставки перекрестной ссылки, похоже, выполняется, хотя и не в том месте.

Кроме того, в моих начальных запусках команда вставляла перекрестную ссылку, чтобы заменить все содержимое ячейки, содержащей список заявки, чтобы она выглядела как «Ошибка! Источник ссылки не найден», потому что «заявка» 1 "абзац, на который была сделана ссылка, была удалена вставкой. Но после того, как я возился с различными местами размещения списка претензий относительно таблицы, я не смог воспроизвести это поведение. (Излишне говорить, что я начинающий программист, и моей технике отладки еще далеко ...)

Буду признателен, если кто-нибудь сможет пролить некоторый свет на происходящее и объяснить, как пропустить границы клетки или иным образом игнорировать их присутствие в этой процедуре.

Sub InsertMultipleClaimReferences () 

If Word.Selection.Type = wdSelectionIP Then
    MsgBox ("Nothing selected")
    Exit Sub
End If

' Inserts patent claim references in selection by replacing number after "claim " in selection with numbered item paragraph number
' having an index corresponding to the replaced number.
' Assumes that the only other numbered paragraph numbering style in the patent
' application, if any, is "[0001]", etc., for the specification paragraphs.


Dim re As VBScript_RegExp_55.RegExp
Set re = New VBScript_RegExp_55.RegExp
Dim listPara As Paragraph

Dim n As Long
Dim matchCount As Long
Dim lastMatchLastIndex As Long
Dim submatch As String

Dim rng As Range
Dim txt As String
Dim allMatches As MatchCollection, m As Match

'Declares RegExp pattern of patent specification paragraph numbering style

re.pattern = "\[[0-9]{4,}\]" 'for numbering style: "[0001]", etc.
re.Global = True
n = 0

'Determines index n of last patent specification paragraph having the above numbering style

For Each listPara In ActiveDocument.ListParagraphs
    If re.Test(listPara.Range.ListFormat.ListString) Then
        n = n + 1
    End If
Next listPara

'Declares RegExp pattern of a reference to a parent patent claim in a dependent patent claim

Set re = New VBScript_RegExp_55.RegExp
re.pattern = "(?:claim\s)(\d+)"
re.IgnoreCase = True
re.Global = True


'Replaces numeric portion of patent claim references in selection with an updatable (using f9 on selection)
' numeric cross reference to the number of the nth list paragraph following the last specification paragraph,
' which is assumed to be the paragraph containing claim n, or the "preamble" (first paragraph following the number)
' of claim n.

txt = Selection.Text
    If re.Test(txt) Then
      Selection.Collapse (wdCollapseStart)
      Set allMatches = re.Execute(txt)
      matchCount = allMatches.count
      lastMatchLastIndex = 0
      For Each m In allMatches
          Selection.MoveStart wdCharacter, m.FirstIndex + 6 - lastMatchLastIndex 'Note: 6 is the character
                'length of "Claim "; so this moves the cursor forward from the end of the last match to the beginning of
                'the numeric portion of the current match
          Selection.MoveEnd wdCharacter, m.length - 6 'selects the claim number
          **Selection.InsertCrossReference ReferenceType:="Numbered item", _
          ReferenceKind:=wdNumberNoContext, ReferenceItem:=n + m.SubMatches(0), _
          InsertAsHyperlink:=True, IncludePosition:=False, SeparateNumbers:=True, _
          SeparatorString:=" " 'inserts the cross reference - this command fails if selection contains a table**
          Selection.Collapse (wdCollapseEnd)
          lastMatchLastIndex = m.FirstIndex + m.length
      Next m

    End If
End Sub

1 Ответ

0 голосов
/ 28 августа 2018

Regex действительно не подходит для возврата диапазонов в документах с таблицами, встроенными изображениями, полями и т. Д. Попробуйте что-то на основе инструментов Word с подстановочными знаками: 

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "<[Cc]laim \<[0-9]@\>"
    .Replacement.Text = ""
    .Forward = True
    .Format = False
    .Wrap = wdFindStop
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    With .Duplicate
      .Collapse wdCollapseEnd
      .MoveStartUntil "<", wdBackward
      .Collapse wdCollapseStart
      .MoveEndUntil ">", wdForward
      .InsertCrossReference ReferenceType:="Numbered item", _
          ReferenceKind:=wdNumberNoContext, ReferenceItem:=.Text, _
          InsertAsHyperlink:=True
    End With
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub
...