Skip check text in tables-CodePudding

How to rewrite such code:

Sub sierotkiTXT_zero()
'szukaj sierotek w tekście

    Dim NumLines As Long
        
       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 "*:] *" Or Selection.Text Like "*([a-z] *" 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(8205) & " "
 End If
          If Result = vbCancel Then
    Exit Sub
 End If
    End If
    
   Selection.MoveRight Unit:=wdCharacter, Count:=3 
Next
End Sub

So that it skips checking the text in the tables? Unfortunately, my way counts each table cell as a line and adds it to the final loop counter. Also, I don't want to check the text in the tables.

For now, I only know how to stop checking if I come across a table.

    If Selection.Information(wdWithInTable) = True Then
  Exit Sub
     End If

[EDIT1] I can seemingly skip the table by adding:

 If Selection.Information(wdWithInTable) = True Then
    Selection.EndKey Unit:=wdRow
    Selection.EndKey Unit:=wdColumn
    Selection.EndKey Unit:=wdRow
    Selection.MoveRight Unit:=wdCharacter, Count:=10

But this is not a universal solution for every table and document (I manage to skip only a certain type of tables) and does not solve the loop counter problem. The whole code needs a change.

[EDIT2] I change script to:

If Selection.Information(wdWithInTable) = True Then
    Selection.EndKey unit:=wdRow
    Selection.EndKey unit:=wdColumn
    Selection.MoveDown unit:=wdLine, Count:=2

work ok on every table. (skip). The only problem is the end counter loop. Because I miscalculate the final number of loops (I skip the table, and count their cells as lines)

[EDIT3] Change:

    Dim NumLines1 As Long
    Dim NumLines2 As Long
    Dim NumLines3 As Long
    Dim mytable As Table

    Selection.EndKey unit:=wdStory, Extend:=wdExtend
    
  NumLines1 = Selection.Range.ComputeStatistics(wdStatisticLines)
  Selection.Collapse

For Each mytable In ActiveDocument.Tables
mytable.Range.Editors.Add wdEditorEveryone
Next
ActiveDocument.SelectAllEditableRanges (wdEditorEveryone)
ActiveDocument.DeleteAllEditableRanges (wdEditorEveryone)
  
  NumLines2 = Selection.Range.ComputeStatistics(wdStatisticLines)
  Selection.Collapse
  
  NumLines3 = NumLines1 - NumLines2

For i = 1 To NumLines3

I have something wrong here, because for 1 table it counts fine, with more tables it counts wrong.

CodePudding user response：

It is not possible to prevent Word from counting the lines in tables.

To prevent your code processing the tables simply check if the selection is in a table and move to the next line, something like:

For i = 1 To NumLines
    Selection.EndKey Unit:=wdLine
    If Not Selection.Information(wdWithInTable) Then
        'do your processing here
    End If
    Selection.MoveRight Unit:=wdCharacter, Count:=3 
Next

EDIT: To completely skip the tables you need to move the selection past the table and move your index forwards, for example:

Sub sierotkiTXT_zero()
    'szukaj sierotek w tekscie
    
    Application.ScreenUpdating = False
    Dim Result As String, tblLines As Long
    Dim rng As Range: Set rng = Selection.Range
    rng.End = ActiveDocument.Range.End
    
    Dim NumLines As Long: NumLines = rng.ComputeStatistics(wdStatisticLines)
    MsgBox "Lines to check " & (NumLines)
    Selection.Collapse
    Dim i As Long
    For i = 1 To NumLines
        Selection.EndKey unit:=wdLine
        If Selection.Information(wdWithInTable) Then
            tblLines = Selection.Tables(1).Range.ComputeStatistics(wdStatisticLines)
            i = i   (tblLines - 1)
            Selection.Move wdLine, tblLines   2
            Selection.EndKey unit:=wdRow
        Else
            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 "*:] *" Or Selection.Text Like "*([a-z] *" 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(8205) & " "
                End If
                If Result = vbCancel Then
                    Exit Sub
                End If
            End If
        End If
        Selection.MoveRight unit:=wdCharacter, Count:=3
    Next
    Application.ScreenUpdating = True

End Sub

CodePudding user response：

I change part of script to:

 Sub sierotkiTXT_zero()
    'szukaj sierotek w przypisach
       Dim j As Integer
       Dim t As Table

       Selection.EndKey unit:=wdStory, Extend:=wdExtend

       j = Selection.Range.ComputeStatistics(wdStatisticLines)
        For Each t In Selection.Range.Tables
            j = j - t.Range.ComputeStatistics(wdStatisticLines)
        Next
      Selection.Collapse
MsgBox "Lines to check " & (j)        
    For i = 1 To j
      
     If Selection.Information(wdWithInTable) = True Then
        Selection.EndKey unit:=wdRow
        Selection.EndKey unit:=wdColumn
        Selection.MoveDown unit:=wdLine, Count:=2
    
         End If

and work OK. Skip tables and end counter are good.