L oop К следующему диапазону с использованием Find VBA Macro

Question

Я пытаюсь кодировать макрос, который находит слово (таблица 1-1), а затем ищет следующее слово в документе (таблица 2-1) и форматирует таблицу 1-1 в фактическую таблицу слов. У меня эта часть разобралась и работает хорошо.

Это циклическая часть, которую я не могу заставить работать. Я хочу, чтобы он перешел на следующий диапазон, чтобы найти набор таблиц, который будет (Таблица 2-1) - (Таблица 3-1). Я хочу, чтобы он делал это для каждой таблицы в документе, пока она не пройдет через все из них.

Вот код:

Sub FindTableFormatIt()
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rng3 As Range
    Dim strTheText As String
    Dim tableEach As Table
    Dim i As Long


    For i = 1 To 100
    Set rng1 = ActiveDocument.Range


            If rng1.Find.Execute(FindText:="Table") Then
                Set rng2 = ActiveDocument.Range(rng1.End, ActiveDocument.Range.End)
                    If rng2.Find.Execute(FindText:="Table") Then
                        Set rng3 = ActiveDocument.Range(rng1.Start, ActiveDocument.Range.End)
                        ActiveDocument.Range(rng3.Start, rng2.Start).ConvertToTable

                    End If
            End If
    Next i          
End Sub

Вот как выглядит слово document.

Table 1-1
Q1. When there is an election for president do you always vote, almost always vote, vote most of the time, vote some of the time, hardly ever vote, or never vote?

                              Total
                             -------

Total                            600
Always                          87.8
Almost always                    6.0
Most of time                     4.3
Sometimes                        2.0

Table 2-1
Q2. For statistical purposes, what is your age?

                              Total
                             -------

Total                            600
18-34                           21.2
     18-29                      13.5
     30-34                       7.7

35-44                           18.1
     35-39                       8.8
     40-44                       9.4

45-54                           16.4

55-64                           18.6
     55-60                      10.9
     61-64                       7.6

65+                             25.7
Mean                            50.0

Table 3-1
Q3. Gender:
(NET DIF 1 - Percent male minus percent female)

                              Total
                             -------

Total                            600
Male                            48.0
Female                          52.0
NET DIF 1                       -4.0

Table 4-1
Q4. If you had to label yourself, would you say you are a liberal, a moderate or a conservative in your political beliefs?
(NET DIF 1 - Percent Conservative minus percent Liberal)

                              Total
                             -------

Total                            600
Liberal                         28.4
     Very Liberal               12.9
     Somewhat Liberal           15.4

Moderate                        31.1

Conservative                    35.3
     Somewhat Conservative      14.7
     Very Conservative          20.6

DK/Refused                       5.3
NET DIF 1                        7.0

Answer 1

У меня наконец есть закодированное решение. Это правильно l oop и отформатирует каждый текст в соответствующий диапазон таблиц и разметит их так, чтобы не было кровотечения таблицы на двух страницах.

Sub FindTableFormatIt()

Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim pagenum As Integer



Set rng1 = ActiveDocument.Range
pagenum = 1



Do Until Not rng1.Find.Execute(FindText:="(^13)<Table>", MatchWildcards:=True)
    Set rng2 = ActiveDocument.Range(rng1.End, ActiveDocument.Range.End)



    If rng2.Find.Execute(FindText:="(^13)<Table>", MatchWildcards:=True) Then
        If rng2.Information(3) > pagenum Then
            Set rng3 = ActiveDocument.Range(rng1.Start - 1, rng1.Start - 1)
            rng3.InsertBreak (wdPageBreak)
            pagenum = rng2.Information(3)
        End If



        ActiveDocument.Range(rng1.Start, rng2.Start - 1).ConvertToTable
        Set rng1 = ActiveDocument.Range(rng2.Start, ActiveDocument.Range.End)

    Else

        If rng2.Information(3) > pagenum Then
            Set rng3 = ActiveDocument.Range(rng1.Start - 1, rng1.Start - 1)
            rng3.InsertBreak (wdPageBreak)
            pagenum = rng2.Information(3)

        End If



        ActiveDocument.Range(rng1.Start, ActiveDocument.Range.End).ConvertToTable
        Set rng1 = ActiveDocument.Range(rng1.End, ActiveDocument.Range.End)

    End If

 Loop
End Sub

Answer 2

Попробуйте:

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  .InsertAfter Chr(12)
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "^13Table"
    .Replacement.Text = "^p^12Table"
    .Forward = True
    .Format = False
    .MatchWildcards = True
    .Wrap = wdFindContinue
    .Execute Replace:=wdReplaceAll
    .Text = "Table*^12"
    .Replacement.Text = ""
    .Wrap = wdFindStop
    .Execute
  End With
  Do While .Find.Found
    .Characters.Last.Delete
    .Start = .Paragraphs(2).Range.End
    .ConvertToTable vbTab
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub