如何在 Word 文档中将表格题注从上方移动到下方，或从下方移动到上方？

作者晓阳修改日期2024-08-29

在 Word 文档中，如果每个表格下方都已插入题注，但您希望将这些题注批量快速地从表格下方移动到表格上方，该如何操作？

通过 VBA 代码，在 Word 中将表格题注从下方移动到上方或反之

要将所有表格题注从表格下方移动到上方，可以借助以下 VBA 代码，请按如下操作：

1. 按住 ALT + F11 键即可打开 Microsoft Visual Basic for Applications 窗口。

2. 点击插入 > 模块，然后将以下宏粘贴到模块窗口中。

在 Word 文档中将表格题注从下方移至上方

Sub ReLabelDownToUpTables()
    Dim I As Long
    Dim xRngPre As Range
    Dim xRngNext As Range
    Application.ScreenUpdating = False
    With ActiveDocument
        For I = .Tables.Count To 1 Step -1
            With .Tables(I).Range
                Set xRngPre = .Characters.First.Previous.Characters.Last
                xRngPre.Select
                Set xRngNext = .Characters.Last.Next.Paragraphs.First.Range
                xRngNext.Select
                With xRngPre
                    .InsertBefore vbCr
                    .Style = xRngNext.Style
                    .Start = .End - 1
                    .End = .Start
                End With
                If Len(xRngNext.Text) > 1 Then
                    xRngNext.End = xRngNext.End - 1
                    xRngNext.Cut
                    xRngNext.Delete
                    xRngPre.Paste
                Else
                    xRngNext.Delete
                End If
            End With
        Next
    End With
    Application.ScreenUpdating = True
End Sub

3. 接着，按下 F5 键运行代码，所有表格题注即会从表格下方移动到上方，详见截图：

所有表格标题从下方移动到上方

注意：如需将表格题注从表格上方移动到下方，请使用以下 VBA 代码：

在 Word 文档中将表格题注从上方移动到下方

Sub ReLabelUpToDownTables()
    Dim I As Long
    Dim xRngPre As Range
    Dim xRngNext As Range
    Application.ScreenUpdating = False
    With ActiveDocument
        For I = .Tables.Count To 1 Step -1
            With .Tables(I).Range
                Set xRngNext = .Characters.First.Previous.Paragraphs.First.Range
                xRngNext.Select
                Set xRngPre = .Characters.Last.Next
                xRngPre.End = xRngPre.End - 1
                xRngPre.Select
                With xRngPre
                    .InsertBefore vbCr
                    .Style = xRngNext.Style
                    .Start = .End - 1
                    .End = .Start
                End With
                If Len(xRngNext.Text) > 1 Then
                    xRngNext.End = xRngNext.End - 1
                    xRngNext.Cut
                    xRngNext.Delete
                    xRngPre.Paste
                Else
                    xRngNext.Delete
                End If
            End With
        Next
    End With
    Application.ScreenUpdating = True
End Sub