根据前后行更改项目符号间距 - Word VBA

Question

我需要一个宏，它可以扫描 word 文档中的所有项目符号，并根据上面和下面的段落行调整间距。我们报告的格式指南是：

• 列表的第一个项目符号在前一段之间有 3pt 的空间，在下一个项目符号之间有 0pt（上面 3pt，下面 0pt）
• 两个子弹之间的子弹将在上方和下方有 0pt 空间
• 列表末尾的项目符号上方为 0pt，下方为 0pt

我尝试了以下代码，但收到一条错误消息，指出“所请求的集合成员不存在”。

Sub BulletAdjust()

Dim oPara As Word.Paragraph
Dim negPara As Integer
Dim posPara As Integer
Dim parpos As Integer



'Select Entire document
Selection.WholeStory

With Selection

    For Each oPara In .Paragraphs

    'parapos = position of selected paragraph (index)
    parapos = ActiveDocument.Range(0, Selection.Paragraphs(1).Range.End).Paragraphs.count
    'loop through paragraph lines
    'negpara = line before selected paragraph
    negPara = parapos - 1
    'pospara = line after selected paragraph
    posPara = parapos + 1

       Select Case oPara.Range.ListFormat.ListType
            'for bullets w/ bullet above and below
            Case Is = WdListType.wdListBullet And Selection.Paragraphs(negPara).Range.ListFormat.ListType = WdListType.wdListBullet And Selection.Paragraphs(posPara).Range.ListFormat.ListType = WdListType.wdListBullet
                'spacing before and after = 0pt
                oPara.SpaceBefore = 0
                oPara.SpaceAfter = 0
            'for bullets w/ bullet above but none below
            Case Is = WdListType.wdListBullet And Selection.Paragraphs(negPara).Range.ListFormat.ListType = WdListType.wdListBullet And Selection.Paragraphs(posPara).Range.ListFormat.ListType <> WdListType.wdListBullet
                'spacing before = 0pt, after = 3pt
                oPara.SpaceBefore = 0
                oPara.SpaceAfter = 3
            'for bullets w/ no bullet above, bullet below
            Case Is = WdListType.wdListBullet And Selection.Paragraphs(negPara).Range.ListFormat.ListType <> WdListType.wdListBullet And Selection.Paragraphs(posPara).Range.ListFormat.ListType = WdListType.wdListBullet
                'spacing before = 3pt, after = 0pt
                oPara.SpaceBefore = 3
                oPara.SpaceAfter = 0
            'for bullets w/ no bullet above, below
            Case Is = WdListType.wdListBullet And Selection.Paragraphs(negPara).Range.ListFormat.ListType <> WdListType.wdListBullet And Selection.Paragraphs(posPara).Range.ListFormat.ListType <> WdListType.wdListBullet
                oPara.SpaceBefore = 3
                oPara.SpaceAfter = 3
            Case Else
                oPara.SpaceBefore = 6
                oPara.SpaceAfter = 6
        End Select

    Next
End With
End Sub

Answer 1

如果有人需要类似的东西，我可以使用以下代码做到这一点：

Sub ParagraphCnt()

Dim parano As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer

Dim oPara As Word.Paragraph

parano = ActiveDocument.Paragraphs.count




For i = 2 To parano
j = i - 1
k = i + 1
Select Case ActiveDocument.Paragraphs(i).Range.ListFormat.ListType

            'for bullets w/ bullet above and below
            Case Is = WdListType.wdListBullet And ActiveDocument.Paragraphs(j).Range.ListFormat.ListType = WdListType.wdListBullet And ActiveDocument.Paragraphs(k).Range.ListFormat.ListType = WdListType.wdListBullet
                'spacing before and after = 0pt
                ActiveDocument.Paragraphs(i).SpaceBefore = 0
                ActiveDocument.Paragraphs(i).SpaceAfter = 0
            'for bullets w/ bullet above but none below
            Case Is = WdListType.wdListBullet And ActiveDocument.Paragraphs(j).Range.ListFormat.ListType = WdListType.wdListBullet And ActiveDocument.Paragraphs(k).Range.ListFormat.ListType <> WdListType.wdListBullet
                'spacing before = 0pt, after = 3pt
                ActiveDocument.Paragraphs(i).SpaceBefore = 0
                ActiveDocument.Paragraphs(i).SpaceAfter = 3
            'for bullets w/ no bullet above, bullet below
            Case Is = WdListType.wdListBullet And ActiveDocument.Paragraphs(j).Range.ListFormat.ListType <> WdListType.wdListBullet And ActiveDocument.Paragraphs(k).Range.ListFormat.ListType = WdListType.wdListBullet
                'spacing before = 3pt, after = 0pt
                ActiveDocument.Paragraphs(i).SpaceBefore = 3
                ActiveDocument.Paragraphs(i).SpaceAfter = 0
            'for bullets w/ no bullet above, below
            Case Is = WdListType.wdListBullet And ActiveDocument.Paragraphs(j).Range.ListFormat.ListType <> WdListType.wdListBullet And ActiveDocument.Paragraphs(k).Range.ListFormat.ListType <> WdListType.wdListBullet
                ActiveDocument.Paragraphs(i).SpaceBefore = 3
                ActiveDocument.Paragraphs(i).SpaceAfter = 3
            Case Else

        End Select

    Next i

End Sub