Home > Back-end >  How stop macro on the end document?
How stop macro on the end document?

Time:10-31

I'm just learning and don't know much yet. I wrote incorrect code

Sub sierotkiTXT_select()

    Do
 
        Selection.EndKey Unit:=wdLine
        Selection.MoveLeft Unit:=wdCharacter, Count:=3, Extend:=wdExtend

        If Selection.Text Like "* [aAwWzZiIoOuUVQ] *" Or Selection.Text Like "*[A-Z]. *" Or Selection.Text Like "* [a-z]. *" Or Selection.Text Like "*z. *" Or Selection.Text Like "*:] *" Then

            Result = MsgBox("OK?", vbYesNoCancel   vbQuestion)

            If Result = vbYes Then

                Selection.MoveRight Unit:=wdCharacter, Count:=1
                Selection.MoveLeft Unit:=wdCharacter, Count:=1
                Selection.Delete
                Selection.InsertAfter Text:=ChrW(160)
                
            End If
            
            If Result = vbCancel Then
            
                Exit Sub
 
            End If
            
        End If
    
        Selection.MoveRight Unit:=wdCharacter, Count:=3
      
    Loop Until Selection.Text = ActiveDocument.Range.Characters.Last

End Sub

and don't know how to stop such a macro at the end of the document (break the loop) without using a

Loop Until Selection.Text = ActiveDocument.Range.Characters.Last

It wouldn't be a problem, but the macro sometimes stops at the end-of-paragraph characters, interpreting them as the end of the document. [EDIT] Ok-ActiveDocument.Range.Characters.Last Still returns empty - that's why it stops. I should not use this.

Examples (main text): before

After run macro: after

Examples (Endnotes): before after

CodePudding user response:

You don't even need a macro for this! All you need is two wildcard Find/Replace opertions, one with:

Find = (<[A-Za-z])^32
Replace = \1^s

and one with:

Find = (<[a-z].)^32
Replace = \1^s

See also: https://www.msofficeforums.com/word-vba/48717-how-i-find-character-line.html

CodePudding user response:

I corrected my code and it works.

Sub sierotkiTXT_select()

'szukaj sierotek

    Dim NumLines As Long
        Application.ScreenUpdating = True
       Selection.EndKey Unit:=wdStory, Extend:=wdExtend  
NumLines = Selection.Range.ComputeStatistics(wdStatisticLines)
  MsgBox "Lines to check " & (NumLines)
  Selection.Collapse
For i = 1 To NumLines
    Selection.EndKey Unit:=wdLine
    Selection.MoveLeft Unit:=wdCharacter, Count:=3, Extend:=wdExtend
   If Selection.Text Like "* [aAwWzZiIoOuUVQ] *" Or Selection.Text Like "*[A-Z]. *" Or Selection.Text Like "* [a-z]. *" Or Selection.Text Like "*z. *" Or Selection.Text Like "*:] *" Then
      Result = MsgBox("Akceptujesz?", vbYesNoCancel   vbQuestion)
 If Result = vbYes Then
      Selection.MoveRight Unit:=wdCharacter, Count:=1
      Selection.MoveLeft Unit:=wdCharacter, Count:=1
      Selection.Delete
      Selection.InsertAfter Text:=ChrW(160)
 End If
          If Result = vbCancel Then
    Exit Sub
 End If
    End If
   Selection.MoveRight Unit:=wdCharacter, Count:=3
Next

End Sub
  • Related