如何在 Word 文件中將表格的題注從上方移至下方，或從下方移至上方？

作者Xiaoyang修改日期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