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

Question

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

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

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

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