Макрос перестал искать то же слово после vbNo - PullRequest
Новая
       43

Макрос перестал искать то же слово после vbNo

1 голос
/ 04 апреля 2020

Добрый день, мастера VBA

Могу ли я попросить вашей помощи относительно моего кода?

Как вы можете видеть ниже, мой код предназначен для поиска слов в определенном c стиле заголовка только и затем преобразовать его в нижний регистр.

Моя проблема - когда я выбираю «Нет» в окне сообщения, мой макрос прекратил поиск того же слова в следующем заголовке.

В моем документе есть несколько заголовков, и мне нужно выполнить поиск за одно и то же слово до последнего заголовка документа.

Я следую СОП, поэтому не могу перевести все слова в нижний регистр.

Надеюсь, вы поможете мне с моей проблемой. Заранее спасибо. 

Sub ChangeCase1()
    Dim StrFind As String, StrRepl As String
    Dim i As Long
    StrFind = "And,Aboard,About,Above,Across,After,Against,Along,Alongside,Amid,Amidst,Among,Around,As,Aside,At,Athwart,Atop,Barring,Before,BehindBelow,Off,On,Onto,Opposite,Out,Outside,Beneath,Beside,Besides,Between,Beyond,But,By,Circa,Concerning,Despite,Down,During,Except,Following,For,From,In,Inside,Into,Like,Mid,Minus,Near,Next,Notwithstanding,Of,Worth,Over,Pace,Past,Per,Plus,Regarding,Round,Since,Than,Through,Throughout,Till,Times,To,Toward,Towards,Under,Underneath,Unlike,Until,Up,Upon,Versus,Via,With,Within,Without"
    Set RngTxt = Selection.Range
    For i = 0 To UBound(Split(StrFind, ","))
        With Selection.Find
            .ClearFormatting
            .Wrap = wdFindContinue
            .Forward = True
            .Format = True
            .MatchCase = True
            .Text = Split(StrFind, ",")(i)
            .Style = ActiveDocument.Styles("K-Heading Level 1")
            .Execute
            While .Found
                If MsgBox("Replace " & Split(StrFind, ",")(i), vbYesNo) = vbYes Then
                    Selection.Range.Case = wdLowerCase
                    Selection.Collapse Direction:=wdCollapseEnd
                    .Execute
                Else
                    GoTo Continue
                End If
            Wend

        End With
Continue:
    Next i
    Call ChangeCase2
End Sub

1 Ответ

0 голосов
/ 04 апреля 2020

Добрый день и добро пожаловать на борт.

Вот некоторые изменения, которые необходимо внести:

  1. После того, как ваш код что-то найдет, он его выберет. Поэтому, когда вы попросите его выполнить поиск снова, он выполнит поиск внутри выбора из последнего результата поиска. У вас уже есть оператор Selection.Collapse, который делает это в случае vbYes. Вам просто нужно применить его в случае vbNo.
  2. Чтобы убедиться, что код будет искать одно слово до конца документа и что он не будет начинаться заново, вы должны изменить .Wrap = wdFindContinue to .Wrap = wdFindStop.
  3. Чтобы убедиться, что код будет искать каждое слово от начала документа до его конца, вы должны изменить With Selection.Find на With ActiveDocument.Content.Find

Итак, ваш код должен быть: 

Sub ChangeCase1()
    Dim StrFind As String, StrRepl As String
    Dim i As Long
    StrFind = "And,Aboard,About,Above,Across,After,Against,Along,Alongside,Amid,Amidst,Among,Around,As,Aside,At,Athwart,Atop,Barring,Before,BehindBelow,Off,On,Onto,Opposite,Out,Outside,Beneath,Beside,Besides,Between,Beyond,But,By,Circa,Concerning,Despite,Down,During,Except,Following,For,From,In,Inside,Into,Like,Mid,Minus,Near,Next,Notwithstanding,Of,Worth,Over,Pace,Past,Per,Plus,Regarding,Round,Since,Than,Through,Throughout,Till,Times,To,Toward,Towards,Under,Underneath,Unlike,Until,Up,Upon,Versus,Via,With,Within,Without"    
    Set RngTxt = Selection.Range
    For i = 0 To UBound(Split(StrFind, ","))
        With ActiveDocument.Content.Find
            .ClearFormatting
            .Wrap = wdFindStop
            .Forward = True
            .Format = True
            .MatchCase = True
            .Text = Split(StrFind, ",")(i)
            .Style = ActiveDocument.Styles("K-Heading Level 1")
            .Execute
            While .Found
                If MsgBox("Replace " & Split(StrFind, ",")(i), vbYesNo) = vbYes Then
                    Selection.Range.Case = wdLowerCase
                End If
                Selection.Collapse Direction:=wdCollapseEnd
                .Execute
            Wend
        End With
    Next i
    'Call ChangeCase2
End Sub
...