Fatal.Lordes
Fatal.Lordes

Reputation: 31

MS Word, VBA, How to select a paragraph within a cell within a table?

I'm new to using VBA to write macros within MS Word. I've worked out how to select the cell within the table, but it doesn't appear I can use the paragraph object with it... or, more likely, I'm doing it wrong.

Essentially, what I'm trying to do, it look for phrase "as follows:" within all the paragraphs of Cell (13,2) of Table(1). If it finds it, I want to see if the next thing that happens after that phrase is a new paragraph with a bullet. If it is, great, nothing more to do. If it isn't, then do a new paragraph with a bullet.

I'm just not sure how to go about this, particularly determining if there is already a bullet or not.

Hoping someone can throw some light on the subject. I'll keep plugging away in the meantime. :)

UPDATE: I've gotten this far where it inserts a return and I was hoping would insert a bullet but it is inserting a bullet in numerous spaces in that Cell rather than after the 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

Upvotes: 2

Views: 3094

Answers (2)

Cindy Meister
Cindy Meister

Reputation: 25663

I've modified your code sample and this works for me. Since you already declare and assign a Range to BIOCell you can use that throughout your macro to identify the cell contents. There's no need to use the "Like" test since Range.Find.Execute returns True if successful, otherwise False. When Find is successful, the Range will change to what has been found (in other words it's no longer the entire cell).

Trying to replace with a paragraph mark isn't working as you wish. Since you need to do something that can't be done with Find/Replace anyway (the bullets) simply add the paragraph mark if Find is successful, put the Range focus at the end of the cell, than apply the Bullets formatting. (Note that there's no need to use Selection if you have the Range object.)

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

If the table cell already has paragraphs of text and you want everything after the Find term to be bulleted, then the code could look like the example that follows.

In this case, a second Range object is used to perform the Find, while BIOCell remains assigned to the entire cell. (Always use the Duplicate property to make a "copy" of a Range that can be used independently. Range is an anamoly in the Office object models: Range=Range makes both Ranges identical - if you change the position of one, the position of the other changes, as well.)

Once Find is successful, the findRange is collapsed to the end of the Find term and moved one paragraph further (to the first paragraph following the found text). The end of the Range is then extended to the end of the cell (end of BIOCell), then moved back a couple of characters so that it doesn't include the end-of-cell markers. (Otherwise the bullets would be applied to the entire cell instead of up through the last paragraph of the cell.)

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

Upvotes: 1

macropod
macropod

Reputation: 13490

Try:

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

Unlike Cindy's code, the above will insert a bullet paragraph regardless of whether the 'as follows:' string terminates with a paragraph break (or anything other than a space) when the following paragraph isn't a bulleted one.

Upvotes: 0

Related Questions