写一个word宏根据文字内容生成表格将中为数字的段落内容作为第一列的内容将对应的责任领导、责任股室、责任人、整改措施、整改时限段落内容分别作为第二至第六列中的内容

Sub GenerateTable() Dim nParas As Integer '段落数 Dim iPara As Integer '段落编号 Dim iRow As Integer '行编号 Dim iCol As Integer '列编号 Dim sParaText As String '段落文本 Dim sValue As String '单元格内容 Dim oTable As Table '表格对象 Dim oCell As Cell '单元格对象 Dim oRange As Range '范围对象 Dim oDoc As Document '文档对象

'获取文档对象
Set oDoc = ActiveDocument

'获取段落数
nParas = oDoc.Content.Paragraphs.Count

'创建表格
Set oRange = oDoc.Range(Start:=oDoc.Content.End, End:=oDoc.Content.End)
Set oTable = oDoc.Tables.Add(oRange, NumRows:=nParas - 1, NumColumns:=5)

'设置表格样式
oTable.Style = "Table Grid"

'遍历段落
iRow = 1
For iPara = 1 To nParas
    '获取段落文本
    sParaText = oDoc.Content.Paragraphs(iPara).Range.Text
    
    '判断段落是否符合要求
    If InStr(sParaText, "(") > 0 And InStr(sParaText, ")") > 0 Then
        '解析段落内容
        sValue = Split(sParaText, "(")(1)
        sValue = Split(sValue, ")")(0)
        
        '填充第一列
        Set oCell = oTable.Cell(iRow, 1)
        oCell.Range.Text = sValue
        
        '填充其他列
        iCol = 2
        For Each sKeyword In Array("责任领导", "责任股室", "责任人", "整改措施", "整改时限")
            sValue = GetParaText(oDoc, iPara, sKeyword)
            Set oCell = oTable.Cell(iRow, iCol)
            oCell.Range.Text = sValue
            iCol = iCol + 1
        Next
        
        '移动到下一行
        iRow = iRow + 1
    End If
Next

End Sub

'获取段落中指定关键字后面的文本 Function GetParaText(oDoc As Document, iPara As Integer, sKeyword As String) As String Dim nParas As Integer '段落数 Dim i As Integer '循环计数器 Dim sParaText As String '段落文本 Dim sValue As String '返回值

'获取段落数
nParas = oDoc.Content.Paragraphs.Count

'查找关键字
sValue = ""
For i = iPara + 1 To nParas
    sParaText = oDoc.Content.Paragraphs(i).Range.Text
    If InStr(sParaText, sKeyword) > 0 Then
        sValue = Trim(Split(sParaText, sKeyword & "：")(1))
        Exit For
    End If
Next

'返回结果
GetParaText = sValue

End Function