Как применить сортировку к определенным таблицам в текстовом документе?

Question

У меня есть система, которая генерирует отчеты о результатах испытаний для меня. Мне удалось создать правильные шаблоны таблиц для использования этой системы. Но по какой-то причине отчет, содержащий таблицы и диаграммы длиной около 950 страниц, был сгенерирован, а таблицы отсортированы в порядке убывания. Я попытался сделать автоматические отчеты для вывода таблиц в порядке возрастания без успеха.

Тогда я начал искать решение этой проблемы. Одним из решений, которое у меня есть, является следующий код VBA. Но когда я применяю его ко всему отчету, он застревает, и Word превращается в «Не отвечает». Я совершенно новичок в VBA и не вижу причины. Подскажите, пожалуйста, почему?

Attribute VB_Name = "SortTable_Ascend"
Sub Find_Text_in_table()

    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Step"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

    Do While Selection.Find.Execute

        If Selection.Information(wdWithInTable) Then

            Selection.Tables(1).SortAscending

        End If
    Loop
End Sub

Кстати, я только ищу определенные таблицы (те, в которых есть столбец со строкой «Шаг» в них) и применяю сортировку к ним. Когда я взял только 100 страниц этого документа и применил этот скрипт, он выполнил свою работу и не застрял.

Answer 1

Вот альтернатива, которая избегает слова найти и заменить.Он также использует более общий метод сортировки, который копирует диалоговое окно, которое вы получаете при выполнении сортировки по слову.Это может быть полезно, если вы хотите отсортировать по нескольким столбцам.

Option Explicit

Sub test()
    SortTables_WithKey "Step"
End Sub

Sub SortTables_WithKey(this_key As String)

Dim myIndex                            As Long
Dim myLastTable                        As Long

    myLastTable = ActiveDocument.Tables.Count
    Application.ScreenUpdating = False
    Application.Options.Pagination = False

    For myIndex = 1 To myLastTable
        ' MS have deprecated the use of statusbar so if this line
        ' but it still appears to work in Word 2016
        Application.StatusBar = "Table " & CStr(myIndex) & " of " & CStr(myLastTable)

        If InStr(ActiveDocument.Tables(myIndex).Range.text, this_key) > 0 Then
            ' https://docs.microsoft.com/en-us/office/vba/api/word.table.sort
            ' Replicates the type of sort when done using Word
            ActiveDocument.Tables(myIndex).Sort _
                excludeheader:=True, _
                fieldnumber:=1, _
                sortfieldtype:=wdSortFieldAlphanumeric, _
                sortorder:=wdSortOrderAscending

        End If

        DoEvents
    Next

    Application.ScreenUpdating = True
    Application.Options.Pagination = True

End Sub

Отредактировано, чтобы пересмотреть сабвуфер, чтобы включить рекомендации по обновлению экрана, событиям и нумерации страниц (другие опередили меня).Я также включил код для размещения сообщения в строке состояния (нижний левый угол окна слова), в котором будет отображаться прогресс (таблица x of y).Я протестировал вышеуказанное на имеющемся у меня документе со 125 таблицами, и (без сортировки таблиц) он завершился примерно за 5 секунд.

Я также исправил одну ошибку, которую я сделал

sortorder:=wdSortAscending

должен иметьБыло

sortorder:=wdSortOrderAscending

Отсюда добавление «опции явного» в начале кода.

Answer 2

Попробуйте:

Sub SortTables()
Application.ScreenUpdating = False
Dim t As Long, bfit As Boolean
With ActiveDocument
  For t = 1 To .Tables.Count
    With .Tables(t)
      If InStr(1, .Range.Text, "Step", 0) > 0 Then
        bfit = .AllowAutoFit
        If bfit = True Then .AllowAutoFit = False
        .SortAscending
        If bfit = True Then .AllowAutoFit = True
      End If
    End With
    If t Mod 100 = 0 Then DoEvents
  Next
End With
Application.ScreenUpdating = True
End Sub

Отключение обновления экрана и свойства автозаполнения таблицы увеличат производительность.Периодический запуск DoEvents при длительных операциях также дает Word некоторое передышку.

Answer 3

Следующее должно обрабатываться немного быстрее и проходить через все таблицы.

Sub Find_Text_in_table()
Dim rng As word.Range, tbl As word.Table
ActiveDocument.ActiveWindow.View.Type = word.WdViewType.wdNormalView
Application.Options.Pagination = False
For Each tbl In ActiveDocument.Tables
    Set rng = tbl.Range
    rng.Find.ClearFormatting
    With rng.Find
        .Text = "Step"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute
        If .found Then
            If rng.InRange(tbl.Range) Then
                tbl.SortAscending
            End If
        End If
    End With
Next
ActiveDocument.ActiveWindow.View.Type = word.WdViewType.wdPrintView
Application.Options.Pagination = True
End Sub