Почему не находит и не заменяет в VBA Macro настройкой подстановочных знаков, распознает гиперссылку как законную часть текста - PullRequest
0 голосов
/ 06 марта 2020

Приведенный ниже макрос VBA Word запускается после выбора нескольких абзацев или для каждого примера. Я прилагаю пример файла .rtf, для которого запускается макрос.
Библейские ссылки в начале абзацев все получают пару вокруг них, кроме той, которая имеет гиперссылку. Мой макрос виноват или это проблема Word 2010.
В качестве дополнительной точки было бы полезно узнать, работает ли это на Office 365 (я пробовал то же самое на LibreOffice, и оно совпадает, даже если слово один с гиперссылкой
(^) ([A-Z123I] {1,3} [^] {1,15}) ([0-9] {1,3}: [0-9 - \ -] {1 , 7})
$ 1 $ 2 $ 3 $ 2 $ 3
Поэтому, пожалуйста, не предлагайте мне приложить какие-либо усилия, чтобы выяснить, должно ли это работать, или что я не пробовал другие настройки. Это было бы более полезно чтобы кто-то написал, что у него не получилось хотя бы показать, что они потратили время на загрузку файла макроса теста и фактически провели тест)

    Private Sub RelRefWithBibleName_Click()

     InSelection = False
     If selection.Type = wdSelectionIP Then InSelection = True

     If InSelection = True Then

         MsgBox ("select some text")
         Exit Sub
     End If

     selection.Find.ClearFormatting
     selection.Find.Replacement.ClearFormatting
     selection.Find.Replacement.Font.Reset
     Application.ScreenUpdating = False
     With selection

         'Added this to make selection go beyond the start of the selected paragraph
         'so that the detection would work
         selection.MoveStartUntil Cset:=wdCharacter, Count:=wdBackward
         strFindText = "([^13])([A-Z123I ]{1,3}[! ]{1,15} )([0-9]{1,3}:[0-9\-\–]{1,7})"
         strReplaceText = "\1<ref>\2\3</ref>\2\3"

     End With

     With selection.Find
         .MatchWildcards = True
         .ClearFormatting
         .Replacement.ClearFormatting
         .text = strFindText
         .Replacement.text = strReplaceText
         .Format = False
         .MatchWholeWord = True
         .Forward = True
         .Wrap = wdFindStop
     End With


     selection.Find.Execute Replace:=wdReplaceAll
     selection.Shrink
     selection.Move
     Application.ScreenUpdating = True
     selection.Find.ClearFormatting
     selection.Find.Replacement.ClearFormatting

     End Sub

Ответы [ 2 ]

0 голосов
/ 08 марта 2020

Цикл по коллекции гиперссылок не представляет особой проблемы. Тем не менее, есть другой способ:

Sub Demo()
Application.ScreenUpdating = False
Dim RngFnd As Range, StrTxt As String
With Selection
  Set RngFnd = .Range
  With .Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = "[A-Z1-3 ]{1,3}[! \<\>]{1,15} [0-9]{1,3}:[0-9\-\?]{1,7}"
      .Replacement.Text = ""
      .Forward = True
      .Format = False
      .Wrap = wdFindStop
      .MatchWildcards = True
      .Execute
    End With
    Do While .Find.Found
      If .InRange(RngFnd) Then
        If .Paragraphs.Count > 1 Then .Start = .Paragraphs(1).Range.End
        If .Start = .Paragraphs(1).Range.Start Then
          StrTxt = .Text
          .InsertBefore "<ref>" & StrTxt & "</ref>"
          .Font.Bold = False
          .Start = .End - Len(StrTxt)
          .Font.Bold = True
        End If
        If .Hyperlinks.Count > 0 Then
          If .Hyperlinks(1).Range.Start = .Paragraphs(1).Range.Start Then
            With .Hyperlinks(1).Range
              StrTxt = .Text
              .InsertBefore "<ref>" & StrTxt & "</ref>"
              .Font.Bold = False
              .Start = .End - Len(StrTxt)
              .Font.Bold = True
            End With
          End If
        End If
      Else
        Exit Do
      End If
      .Collapse wdCollapseEnd
      .Find.Execute
    Loop
  End With
End With
RngFnd.Select
Application.ScreenUpdating = True
End Sub
0 голосов
/ 07 марта 2020

В ваших выражениях «Найти / Заменить» нет ничего плохого, хотя их можно упростить:

strFindText = "([^13])([A-Z1-3 ]{1,3}[! ]{1,15} [0-9]{1,3}:[0-9\-\–]{1,7})"
strReplaceText = "\1<ref>\2</ref>\2"

Версия Word не имеет значения. Для гиперссылок вы можете l oop просмотреть коллекцию гиперссылок и, если применимо, протестировать отображаемый текст, прежде чем вставлять теги по обе стороны от них.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...