如何在Word文檔中將表格題注從上方移動到下方，或者反之？

Author: Xiaoyang Last Modified: 2025-05-12

在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鍵運行此代碼，所有表格題注都會從表格下方移動到上方，請參見截圖：

All table captions are moved from below to above

注意：要將表格題注從表格上方移動到下方，請應用以下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