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