[vba]快速更新表格标题序号

Word中的表格序号可以通过添加“题注”的方式进行自动管理，但是有些特殊情况下采用了人工编号的方式。

随着表格的增加，表格序号的更新成为繁重的工作，使用下面的VBA脚本可以快速的更新。

使用要求：

1.表格标题必须位于表格上方一行

2.表格标题必须以“表”字开头

3.表格标题中必须出现数字

建议使用的时候在Selection.Text = str(i)这一行下断点，观察修改过程，避免错误修改

Option Explicit

'更新表格序号
Public Sub 更新表格序号()
    
    Application.ScreenUpdating = False

    Dim oDoc As Document
    Dim oTable As Table
    Dim i As Long
    Dim sLine As String
    Dim sNumber As String
    
    Set oDoc = Application.ActiveDocument
    For i = 1 To oDoc.Tables.Count - 1
        Set oTable = oDoc.Tables(i)
        '选择表格
        oTable.Select
        '光标上移一行
        Selection.MoveUp Unit:=wdLine, Count:=1
        '选择到行尾
        Selection.EndKey Unit:=wdLine, Extend:=wdExtend
        
        sLine = Selection.Text
        If Left(sLine, 1) = "表" Then
            sNumber = getFirstNumber(sLine, 2)
            '搜索数字
            findAndSelect sNumber
            '选中数字是在表格标题中
            If Len(sNumber) > 0 And Selection.Text = sNumber And InStr(1, sLine, sNumber) Then
                '请在此处下断点
                '修改表格序号
                Selection.Text = str(i)
            End If
        End If
    Next
    
    Application.ScreenUpdating = True
End Sub

'获取字符串中首次出现的数字
Private Function getFirstNumber(ByVal str As String, ByVal start As Long) As String
    Dim i As Long
    Dim ret As String
    Dim ch As String
    For i = start To Len(str) - 1
        ch = Mid(str, i, 1)
        If IsNumeric(ch) Then
            ret = ret & ch
        ElseIf ch = " " Then
        Else
            Exit For
        End If
    Next
    getFirstNumber = ret
End Function

'查找并选择
Private Sub findAndSelect(ByRef sToken As String)
    With Selection.Find
        .Text = sToken
        .Replacement.Text = ""
        .Forward = False
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
End Sub