MS Word，VBA，如何在表格的单元格中选择段落？

我不熟悉使用VBA在MS Word中编写宏。我已经解决了如何选择表格中的单元格，但似乎我无法使用段落对象。。。或者，更可能的是，我做错了

本质上，我想做的是，在表（1）的单元格（13,2）的所有段落中寻找短语“如下所示”。如果它找到了，我想看看在这个短语之后发生的下一件事是否是一个新的段落和一个项目符号。如果是，那太好了，没什么可做的了。如果不是，那么用一个项目符号写一个新段落

我只是不知道该怎么做，尤其是确定是否已经有子弹了

希望有人能对这个问题有所了解。在此期间，我将继续努力。：）

更新：到目前为止，它插入了一个报税表，我希望插入一个项目符号，但它在该单元格的多个空格中插入了一个项目符号，而不是在vbCr之后：

Dim BIOCell As range
With ActiveDocument
    Set BIOCell = .range(Start:=.Tables(1).Cell(13, 2).range.Start, _
        End:=.Tables(1).Cell(13, 2).range.End)
    BIOCell.Select
End With

With ActiveDocument.Tables(1)
    If .Cell(13, 2).range.Text Like "*as follows:*" Then
        With Selection.Find
            .Text = "as follows: "
            .Replacement.Text = "as follows:" & vbCr
                Selection.range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
                    ListGalleries(wdBulletGallery).ListTemplates(1), ContinuePreviousList:= _
                    False, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
                    wdWord10ListBehavior
            .Execute Replace:=wdReplaceAll
            End With
        Else
            MsgBox "couldn't find it"
    End If
End With

---

我已经修改了您的代码示例，这对我很有用。由于您已经为BIOCell声明并指定了一个范围，因此可以在整个宏中使用该范围来标识单元格内容。无需使用“Like”测试，因为

Range.Find.Execute

如果成功将返回True，否则返回False。当查找成功时，范围将更改为已找到的范围（换句话说，它不再是整个单元格）

试图替换为段落标记并没有按照您的意愿工作。由于您需要执行查找/替换无法完成的操作（项目符号），如果查找成功，只需添加段落标记，将范围焦点放在单元格的末尾，然后应用项目符号格式。（请注意，如果有范围对象，则无需使用选择。）

如果表格单元格已经有了文本段落，并且您希望在Find术语之后的所有内容都加上项目符号，那么代码可能与下面的示例类似

在这种情况下，第二个范围对象用于执行查找，而生物单元仍然分配给整个单元。（始终使用

Duplicate

属性对可以独立使用的范围进行“复制”。范围是Office对象模型中的一个变量：

Range

=

Range

使两个范围相同-如果更改一个范围的位置，其他范围的位置也会更改。）

一旦查找成功，findRange将折叠到查找项的末尾，并进一步移动一段（到查找到的文本后面的第一段）。然后将范围的结尾延伸到细胞的结尾（生物细胞的结尾），然后向后移动几个字符，使其不包括细胞的结尾标记。（否则，项目符号将应用于整个单元格，而不是应用于单元格的最后一段。）

尝试：

子演示（）
Application.ScreenUpdating=False
尺寸与射程相同，长度与射程相同
使用ActiveDocument.Tables（1）单元格（13,2）
设置Rng=.Range
用。范围
和…一起找
.ClearFormatting
.Replacement.ClearFormatting
.Text=“如下所示：”
.Replacement.Text=“”
.Forward=True
.Wrap=wdFindStop
.Format=False
.MatchCase=False
.MatchWholeWord=False
.MatchWildcards=False
.MatchSoundsLike=False
.MatchAllWordForms=False
.执行
以
如果.Find.Find=False，则
MsgBox“找不到它”
出口接头
如果结束
找，找，找到
如果.InRange（Rng）那么
如果.Characters.Last.Next vbCr，则在vbCr之后插入（&vbCr）
如果.parations.Last.Next.Range.ListFormat.ListType wdListBullet，则
如果Len（.parations.Last.Next.Range.Text）>1，则vbCr后面的.insert
.段落.Last.Next.Range.ListFormat.ApplyListTemplateWithLevel_
ListTemplate:=ListGalleries（wdBulletGallery）。ListTemplates（1）_
ContinuePreviousList:=False，ApplyTo:=wdListApplyToWholeList_
DefaultListBehavior:=wdWord10ListBehavior
如果结束
其他的
退出Do
如果结束
.倒塌
.Find.Execute
环
以
以
Application.ScreenUpdating=True
端接头

---

与Cindy的代码不同，当以下段落不是带项目符号的段落时，无论“如下：”字符串是否以段落分隔符（或空格以外的任何字符）终止，上面都将插入一个项目符号段落。

首先，感谢Cindy和Macrood提供的信息和帮助。对于延迟响应表示歉意，但我没有在工作，这就是我试图编写此代码以帮助完成某些任务的地方。我会尝试一下，现在我回来了，并将建议！再次感谢！嗨，我试过上面的代码，两种代码都非常有效！非常感谢。不过，我有两个问题。首先，代码的哪一部分决定了项目符号项的缩进边距都在一行中（对不起，我不知道正确的术语）。例如，如果段落超过一行，它会在第一行的开始处换行。第二，我该如何修改代码，使该单元格中“如下”之后的每一段都需要项目符号，而不仅仅是第一段？我会继续努力解决这个问题，但我想我会抓住这个机会问一下1） 它是“列表定义”的一部分-它在

ListTemplate

（

BIOCell.ListFormat.ApplyListTemplateWithLevel

代码行）中定义。2） 如果你的原始问题中包含了这一点，那就太好了，但我会编辑我的答案，把它也包括进去……非常感谢，辛迪。我将对此进行测试。很抱歉没有包括在原来的问题中，但直到后来我才意识到字符串后面可能有不止一段。直到我在一些样本上测试了宏，我才意识到有些可能不止一个段落。我才意识到我可以点击“编辑的X小时前”并获得更多信息

Sub FindInCellAppendBullets()
    Dim BIOCell As Range
    Dim found As Boolean

    With ActiveDocument
        Set BIOCell = .Range(Start:=.Tables(1).Cell(13, 2).Range.Start, _
            End:=.Tables(1).Cell(13, 2).Range.End)
        BIOCell.Select
    End With

     With BIOCell.Find
        .Text = "as follows: "
        found = .Execute
        If found Then
            BIOCell.InsertParagraphAfter
            BIOCell.Collapse wdCollapseEnd
            BIOCell.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
               ListGalleries(wdBulletGallery).ListTemplates(1), ContinuePreviousList:= _
               False, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
               wdWord10ListBehavior
        Else
            MsgBox "couldn't find it"
        End If
    End With    
End Sub

Sub FindInCellFormatWithBullets()
    Dim BIOCell As Range
    Dim findRange As Range
    Dim found As Boolean

    With ActiveDocument
        Set BIOCell = .Range(Start:=.Tables(1).Cell(13, 2).Range.Start, _
            End:=.Tables(1).Cell(13, 2).Range.End)
        Set findRange = BIOCell.Duplicate
        BIOCell.Select
    End With

     With findRange.Find
        .Text = "as follows: "
        found = .Execute
        If found Then
            findRange.MoveStart wdParagraph, 1
            findRange.End = BIOCell.End - 2
            findRange.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
               ListGalleries(wdBulletGallery).ListTemplates(1), ContinuePreviousList:= _
               False, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
               wdWord10ListBehavior
        Else
            MsgBox "couldn't find it"
        End If
    End With

End Sub

Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range, i As Long
With ActiveDocument.Tables(1).Cell(13, 2)
  Set Rng = .Range
  With .Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = "as follows:"
      .Replacement.Text = ""
      .Forward = True
      .Wrap = wdFindStop
      .Format = False
      .MatchCase = False
      .MatchWholeWord = False
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
      .Execute
    End With
    If .Find.Found = False Then
      MsgBox "couldn't find it"
      Exit Sub
    End If
    Do While .Find.Found
      If .InRange(Rng) Then
        If .Characters.Last.Next <> vbCr Then .InsertAfter vbCr & vbCr
        If .Paragraphs.Last.Next.Range.ListFormat.ListType <> wdListBullet Then
          If Len(.Paragraphs.Last.Next.Range.Text) > 1 Then .InsertAfter vbCr
          .Paragraphs.Last.Next.Range.ListFormat.ApplyListTemplateWithLevel _
            ListTemplate:=ListGalleries(wdBulletGallery).ListTemplates(1), _
            ContinuePreviousList:=False, ApplyTo:=wdListApplyToWholeList, _
            DefaultListBehavior:=wdWord10ListBehavior
        End If
      Else
        Exit Do
      End If
      .Collapse wdCollapseEnd
      .Find.Execute
    Loop
  End With
End With
Application.ScreenUpdating = True
End Sub