如何对word文档中的某些表应用排序？

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

顺便说一句，我只查找某些表（其中包含字符串“Step”的列）并对它们应用排序。当我只拿这本文件的100页并应用这个脚本时，它完成了这项工作并且没有被卡住。

Answer 1

以下应该加快一点，并将通过所有表。

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

Answer 2

这是一个避免单词查找和替换的替代方法。它还使用更通用的Sort方法，该方法复制在单词中进行排序时获得的对话框。如果要对多个列进行排序，这可能会有所帮助。

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

编辑修改sub以包含有关屏幕更新，事件和分页的建议（其他人打败了我）。我还提供了一些代码，用于在状态栏（单词窗口的左下角）中显示一条消息，该消息将显示进度（表x of y）。我在上面的文件中对125个表进行了测试，并且（没有对表进行排序）它在大约5秒钟内完成。

我还纠正了我犯的一个错误

sortorder:=wdSortAscending

本来应该

sortorder:=wdSortOrderAscending

因此，在代码的开头添加了“option explicit”。

Answer 3

尝试：

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

关闭屏幕更新和表自动调整属性将提高性能。在长时间操作中定期运行DoEvent也会为Word提供一些喘息空间。