使用 VBA 重置 MS Word 中表格的列表编号

Question

我在 MS Word 文档中有一个包含四列的模型表，第一列带有编号列表。该列表从第二行开始以“a.”开头。在第一行中，表格标题位于合并第二、第三和第四列单元格之后。

我的要求是复制文档中现成的模型表，并创建另一个与模型表结构相同的表，并在模型表下方，它们之间有一行间隙，这样就不会合并两个表。此外，当从模型表创建新表时，新创建的表的第一列中的编号列表是模型表的第一列中的列表的延续。我需要重置每个新表中的编号，以便列表编号从“a.”重新开始。

我编写了下面提到的代码，但它没有按预期工作。请告诉我哪里出了问题以及解决问题的方法。

Sub GenerateNewTables()
    ' Declarations
    Dim doc As Document
    Dim modelTable As Table
    Dim newTable As Table
    Dim i As Integer
    Dim j As Integer
    Dim lastRow As Integer
    Dim startRow As Integer
    Dim tbl As Table
    Dim oRange As Range
    Dim oModelRange As Range
    
    ' Set the document
    Set doc = ActiveDocument
    
    ' Find the model table
    For Each tbl In doc.Tables
            Set oRange = tbl.Cell(1, 2).Range
            oRange.End = oRange.End - 1
            If oRange.Text = "Details of A1" Then
                Set modelTable = tbl
                Set oModelRange = tbl.Range
                tbl.Range.Copy
                Exit For
            End If
    Next tbl
    
    With ListGalleries(wdOutlineNumberGallery).ListTemplates(7).ListLevels(1)
        .NumberFormat = "%1."
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleLowercaseLetter
        .NumberPosition = CentimetersToPoints(0)
        .Alignment = wdListLevelAlignLeft
        .TextPosition = CentimetersToPoints(0.63)
        .TabPosition = wdUndefined
        '.ResetOnHigher = 0
        .StartAt = 1
        .LinkedStyle = ""
    End With
    
    ' If the model table is found
    If Not modelTable Is Nothing Then

        oModelRange.Collapse Direction:=wdCollapseEnd
        oModelRange.InsertParagraphAfter
        oModelRange.Collapse Direction:=wdCollapseEnd

        ' Loop to generate new tables
        For i = 2 To 3 ' Adjust the number of tables as required
            
            oModelRange.Paste
            
            Set newTable = oModelRange.Tables(oModelRange.Tables.Count)
            newTable.Cell(1, 2).Range.Text = "Details of A" & i
            newTable.Title = "A" & i & "Info"

            newTable.Cell(newTable.Rows.Count, 1).Range.Select
            'ListGalleries(wdOutlineNumberGallery).ListTemplates(7).Name = ""
            Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
                ListGalleries(wdOutlineNumberGallery).ListTemplates(7), _
                ContinuePreviousList:=False, ApplyTo:=wdListApplyToWholeList, _
                DefaultListBehavior:=wdWord10ListBehavior

            oModelRange.Collapse Direction:=wdCollapseEnd
            oModelRange.InsertParagraphAfter
            oModelRange.Collapse Direction:=wdCollapseEnd
        
        Next i
    Else
        MsgBox "Model table not found."
    End If

End Sub

上面的代码不会更改每个新表中的第一项。仅连续项目可见更改，即，如果模型表 T1 具有来自“a”的列表。到't.'，新创建的表T2显示为u.，a.，b.，c。 ....s。进一步的新表 T3 可见 v.、a.、b.、c。 ... s。我怎样才能在 T2 中用“a.”列出列表？到“t”。 T3 也带有“a”。到“t”。使用VBA并仍然保持每个表中的列表完整，即每个表只有一个列表？我需要对上述代码进行哪些更改？我在概念上哪里出了问题？请帮忙。

Answer 1

• 您的代码即将完成。
• 更改：应用前选择

  Cell(2, 1)

  ApplyListTemplateWithLevel

Option Explicit
Sub GenerateNewTables()
    ' Declarations
    Dim doc As Document
    Dim modelTable As Table
    Dim newTable As Table
    Dim i As Integer
    Dim j As Integer
    Dim lastRow As Integer
    Dim startRow As Integer
    Dim tbl As Table
    Dim oRange As Range
    Dim oModelRange As Range
    ' Set the document
    Set doc = ActiveDocument
    ' Find the model table
    For Each tbl In doc.Tables
            Set oRange = tbl.Cell(1, 2).Range
            oRange.End = oRange.End - 1
            If oRange.Text = "Details of A1" Then
                Set modelTable = tbl
                Set oModelRange = tbl.Range
                tbl.Range.Copy
                Exit For
            End If
    Next tbl
    With ListGalleries(wdOutlineNumberGallery).ListTemplates(7).ListLevels(1)
        .NumberFormat = "%1."
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleLowercaseLetter
        .NumberPosition = CentimetersToPoints(0)
        .Alignment = wdListLevelAlignLeft
        .TextPosition = CentimetersToPoints(0.63)
        .TabPosition = wdUndefined
        '.ResetOnHigher = 0
        .StartAt = 1
        .LinkedStyle = ""
    End With
    ' If the model table is found
    If Not modelTable Is Nothing Then
        oModelRange.Collapse Direction:=wdCollapseEnd
        oModelRange.InsertParagraphAfter
        oModelRange.Collapse Direction:=wdCollapseEnd
        ' Loop to generate new tables
        For i = 2 To 3 ' Adjust the number of tables as required
            oModelRange.Paste
            Set newTable = oModelRange.Tables(oModelRange.Tables.Count)
            newTable.Cell(1, 2).Range.Text = "Details of A" & i
            newTable.Title = "A" & i & "Info"
            newTable.Cell(2, 1).Range.Select
            'ListGalleries(wdOutlineNumberGallery).ListTemplates(7).Name = ""
            Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
                ListGalleries(wdOutlineNumberGallery).ListTemplates(7), _
                ContinuePreviousList:=False, ApplyTo:=wdListApplyToWholeList, _
                DefaultListBehavior:=wdWord10ListBehavior
            oModelRange.Collapse Direction:=wdCollapseEnd
            oModelRange.InsertParagraphAfter
            oModelRange.Collapse Direction:=wdCollapseEnd
        Next i
    Else
        MsgBox "Model table not found."
    End If
End Sub