Finding bullet points in a slide using VBA in PowerPoint

Hello all,


How can we find bullet points present in slides? Following is the code that inserts bullets of desired color, shape before all the text present in slides(even before text/paragraph that doesn't have bullets). But, I want this to identify bullets and change them if they are not of square shape and blue color. Please help me.

I found this article. But this is for word.

https://wordribbon.tips.net/T008259_...aragraphs.html

Sub ChangeBullets()
Dim osld As Slide
Dim oshp As Shape
Dim L As Long
Dim lngCount As Long
Dim iRow As Integer
Dim iCol As Integer
Dim otr As TextRange
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
Select Case oshp.HasTable
Case Is = True
'loop through table
For iRow = 1 To oshp.Table.Rows.Count
For iCol = 1 To oshp.Table.Columns.Count
If oshp.Table.Cell(iRow, iCol).Shape.TextFrame.HasText Then ' Instead if text has bullets associate with it then execute below code.
With oshp.Table.Cell(iRow, iCol).Shape.TextFrame.TextRange
With .ParagraphFormat.bullet
.Visible = msoCTrue
.RelativeSize = 1
.Character = 167
With .Font
.Color.RGB = RGB(95, 151, 250) ' RGB for blue color
.Name = "Wingdings"
End With
End With
End With
End If
Next iCol
Next iRow
Case Is = False
If oshp.HasTextFrame Then
If oshp.TextFrame.HasText Then
With oshp.TextFrame.TextRange
With .ParagraphFormat.bullet
.Visible = msoCTrue
.RelativeSize = 1
.Character = 167
With .Font
.Color.RGB = RGB(255, 192, 0) ' RGB for template yellow colour bullets
.Name = "Wingdings"
End With
End With
End With

End If
End If
End Select
Next oshp
Next osld
End Sub

See if this is close.

Code:

---

Sub square_bullets()

Dim iRow As Integer
Dim iCol As Integer
Dim osld As Slide
Dim oshp As Shape
Dim otr2 As TextRange2
Dim otbl As Table
Dim L As Long


For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.HasTable Then
Set otbl = oshp.Table
For iRow = 1 To otbl.Rows.Count
For iCol = 1 To otbl.Columns.Count
If otbl.Cell(iRow, iCol).Shape.TextFrame2.HasText Then
For L = 1 To otbl.Cell(iRow, iCol).Shape.TextFrame2.TextRange.Paragraphs.Count
Call fixTR2(otbl.Cell(iRow, iCol).Shape.TextFrame2.TextRange.Paragraphs(L))
Next L
End If
Next iCol
Next iRow
Else
If oshp.HasTextFrame Then
If oshp.TextFrame2.HasText Then
For L = 1 To oshp.TextFrame2.TextRange.Paragraphs.Count
Call fixTR2(oshp.TextFrame2.TextRange.Paragraphs(L))
Next L
End If
End If
End If


Next oshp
Next osld
End Sub




Sub fixTR2(otxr2 As TextRange2)
With otxr2.ParagraphFormat.Bullet
If .Visible Then
If .Type = 1 Then
.Font.Name = "Wingdings"
.Character = 167
.UseTextColor = False
.Font.Fill.ForeColor.RGB = RGB(95, 151, 250)
End If
End If
End With
End Sub

---

I added a condition to check bullet type "If .ParagraphFormat.Bullet = msoTrue Then" execute rest. Now, it works. Thanks for the insight John, this will be helpful in near future:)

I don't think your extra line is necessary. Did it not work as written?

It absolutely worked as expected, thank you John. I tried the other way, which worked fine too.:) I am curious, how did the code check for bullet type. I can see you used type=1, where can find more info on this. Thanks again.

Type 1 is unnumbered. This means that any NUMBER bullets will not become blue squares.

Type = 1 is an enumeration of predefined PP constants. 1 = ppBulletUnnumbered or msoBulletUnnumbered

F2 in the editor brings up the object brower
Attachment 24921


Intellisense works better for things I don't use very often

Attachment 24920

Code:

---

Sub fixTR2(otxr2 As TextRange2)
    With otxr2.ParagraphFormat.Bullet
        If .Visible Then
          If .Type = msoBulletUnnumbered Then
                .Font.Name = "Wingdings"
                .Character = 167
                .UseTextColor = False
                .Font.Fill.ForeColor.RGB = RGB(95, 151, 250)
          End If
        End If
    End With
End Sub

---

Personally, since I can't remember the actual value for such things, I try to the the VBA constants for such things, but either way is fine

Thanks. This so helpful and enlightening. :)