在WPS中利用wordVBA实现批量识别题目数量和自动生成序号，方便在导航窗格中进行拖动排序

 原来的文件

 运行程序后的效果

主要代码如下：

Sub 批量插入题目编号()
'快捷键ALT+1

    Dim i As Integer
        批量五号加粗设置为标题3

    
    'timuCount = CInt(InputBox("请输入题目总数：")) '输入总数
    自动查询题量
    Selection.HomeKey Unit:=wdStory, Extend:=wdMove '回到文档的起点

    
    '打开文字文稿1且复制题目序号
    Documents.Open FileName:="C:\文字文稿1.docx", ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=True, PasswordDocument:="", PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", Format:=0, Encoding:=0, Visible:=True, OpenAndRepair:=False, DocumentDirection:=0, NoEncodingDialog:=True
    ActiveDocument.Paragraphs(1).Range.Copy
    ActiveDocument.Close

    
    For i = 1 To timuCount
        If i <= 1 Then
            查找定位到题号
            Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdMove '光标右移动一位
            Selection.HomeKey Unit:=wdLine, Extend:=wdMove
            Selection.PasteAndFormat Type:=wdUseDestinationStylesRecovery ' 粘贴
        Else
            '查找定位到题号
            查找定位到题号
            Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdMove '光标右移动一位
            Selection.HomeKey Unit:=wdLine, Extend:=wdMove
            Selection.PasteAndFormat Type:=wdUseDestinationStylesRecovery ' 粘贴
        End If
    Next
End Sub
Sub 批量五号加粗设置为标题3()
    自动查询五号加粗字体数量
    Dim i As Integer ' 循环部分
    For i = 1 To wuhaojiacuCount
        查找并选中五号加粗字体
        Selection.Style = "标题 3"
    Next
End Sub

Sub 自动查询题量()
'
' Macro1 Macro
' 宏由 ZPL 录制，时间: 2022/11/19
'
    Dim j   '记录第一个题号光标位置
    Dim k   '记录第最后一个题号光标位置
    'Public timuCount As Integer '记录总题量（全局变量要在函数外定义）
    Dim i As Integer
    Do
        If i <= 0 Then
            查找定位到题号
            j = Selection.Range.Start + 4
            i = i + 1

        Else
            查找定位到题号
            k = Selection.Range.Start + 4
            i = i + 1
        End If

    Loop Until j = k
    
    timuCount = i - 1
End Sub

Sub 查找并选中五号加粗字体()
'
' 查找五号加粗字体 Macro
' 宏由 ZPL 录制，时间: 2022/11/19
'

'
    Selection.Find.Font.Bold = 1
    Selection.Find.Font.Size = 10.5
    With Selection.Find.Font
        .Bold = 1
        .Italic = 0
        .SmallCaps = 0
        .AllCaps = 0
        .DisableCharacterSpaceGrid = False
        .NameFarEast = ""
        .NameAscii = ""
        .NameOther = ""
        .NameBi = ""
        .Bold = 1
        .Italic = wdUndefined
        .BoldBi = wdUndefined
        .ItalicBi = wdUndefined
        .Subscript = wdUndefined
        .Superscript = wdUndefined
        .StrikeThrough = wdUndefined
        .DoubleStrikeThrough = wdUndefined
        .SmallCaps = wdUndefined
        .AllCaps = wdUndefined
        .Hidden = wdUndefined
        .Scaling = wdUndefined
    End With
    With Selection.Find.Font
        .Bold = 1
        .Italic = 0
        .SmallCaps = 0
        .AllCaps = 0
        .DisableCharacterSpaceGrid = False
        .NameFarEast = ""
        .NameAscii = ""
        .NameOther = ""
        .NameBi = ""
        .Bold = 1
        .Italic = wdUndefined
        .BoldBi = wdUndefined
        .ItalicBi = wdUndefined
        .Subscript = wdUndefined
        .Superscript = wdUndefined
        .StrikeThrough = wdUndefined
        .DoubleStrikeThrough = wdUndefined
        .SmallCaps = wdUndefined
        .AllCaps = wdUndefined
        .Hidden = wdUndefined
        .Scaling = wdUndefined
    End With
    With Selection.Find
        .Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .MatchCase = False
        .MatchByte = False
        .MatchWildcards = False
        .MatchWholeWord = False
        .MatchFuzzy = False
        .Replacement.Text = ""
    End With
    With Selection.Find
        .Style = ""
        .Highlight = wdUndefined
        With .Replacement
            .Style = ""
            .Highlight = wdUndefined
        End With
    End With
    Selection.Find.Execute Replace:=wdReplaceNone
End Sub
Sub 自动查询五号加粗字体数量()
'
' Macro1 Macro
' 宏由 ZPL 录制，时间: 2022/11/19
'
    Dim j   '记录第一个题号光标位置
    Dim k   '记录第最后一个题号光标位置
    'Public wuhaojiacuCount As Integer '记录五号加粗字体数量
    Dim i As Integer
    i = 0
    Do
        If i <= 0 Then
            查找并选中五号加粗字体
            j = Selection.Range.Start + 4
            i = i + 1

        Else
            查找并选中五号加粗字体
            k = Selection.Range.Start + 4
            i = i + 1
        End If

    Loop Until j = k
    
    wuhaojiacuCount = i - 1
End Sub
Sub 查找定位到题号()
'
' Macro1 Macro
' 宏由 ZPL 录制，时间: 2022/11/17
'
    Selection.Find.Font.Reset
    Selection.Find.ParagraphFormat.Reset
    With Selection.Find
        .Text = "^p[0-9]{1,3}[.．、]"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchCase = True
        .MatchByte = True
        .MatchWildcards = True
        .MatchWholeWord = False
        .MatchFuzzy = False
        .Replacement.Text = ""
    End With
    With Selection.Find
        .Style = ""
        .Highlight = wdUndefined
        With .Replacement
            .Style = ""
            .Highlight = wdUndefined
        End With
    End With
    Selection.Find.Execute Replace:=wdReplaceNone
End Sub