VBA bullets to work across cells - currently does selected text

[RayKay]

Hi John, just one last tool please

I have the below code from yourself, which works GREAT for selected text in a table cell that use bullet levels.
I have tried for several hours to get this to work on selected cells

Is there a way to make this work on selected cells? (Or better still, to work on both Selected Text or Selected Cells, depending on the user)
Thank you.

Code:

Sub TableBulletCells()
Dim I As Integer
With Application.ActiveWindow.Selection
If .Type = ppSelectionText Then
I = 1
For I = 1 To .TextRange2.Paragraphs.Count
With .TextRange2.Paragraphs(I)
Select Case .ParagraphFormat.IndentLevel
Case Is = 1
.ParagraphFormat.Alignment = ppAlignLeft
.ParagraphFormat.FirstLineIndent = cm2Points(-0.5)
.ParagraphFormat.LeftIndent = cm2Points(0.5)
With .ParagraphFormat.Bullet
.visible = msoCTrue
With .Font
.Name = "Wingdings"
.Size = 12
.Fill.ForeColor.RGB = RGB(219, 0, 17)
End With
.Character = 167
End With
With .Font
.Name = "Arial"
.Size = 12
.Bold = False
End With
Case Is = 2
.ParagraphFormat.Alignment = ppAlignLeft
.ParagraphFormat.FirstLineIndent = cm2Points(-0.5)
.ParagraphFormat.LeftIndent = cm2Points(1)
With .ParagraphFormat.Bullet
.visible = msoCTrue
With .Font
.Size = 12
.Name = "Arial"
.Fill.ForeColor.RGB = RGB(219, 0, 17)
End With
.Character = 8211
End With
With .Font
.Name = "Arial"
.Size = 12
.Bold = False
End With
Case Is = 3
.ParagraphFormat.Alignment = ppAlignLeft
.ParagraphFormat.FirstLineIndent = cm2Points(-0.5)
.ParagraphFormat.LeftIndent = cm2Points(1.5)
With .ParagraphFormat.Bullet
.visible = msoCTrue
With .Font
.Name = "Wingdings"
.Size = 12
.Fill.ForeColor.RGB = RGB(219, 0, 17)
End With
.Character = 167
End With
With .Font
.Name = "Arial"
.Size = 12
.Bold = False
End With
Case Is = 4
.ParagraphFormat.Alignment = ppAlignLeft
.ParagraphFormat.FirstLineIndent = cm2Points(-0.5)
.ParagraphFormat.LeftIndent = cm2Points(2)
With .ParagraphFormat.Bullet
.visible = msoCTrue
With .Font
.Name = "Arial"
.Size = 12
.Fill.ForeColor.RGB = RGB(219, 0, 17)
End With
.Character = 8211
End With
With .Font
.Name = "Arial"
.Size = "12"
.Bold = False
End With
End Select
End With
Next I
End If
End With


End Sub




Function cm2Points(inVal As Single)
cm2Points = inVal * 28.346
End Function

[John Wilson]

Last answer for a week or so as I really am busy!

Sub TableBulletCells()    
Dim I As Integer
    Dim otbl As Table
    Dim iRow As Integer
    Dim iCol As Integer
    On Error Resume Next
    Err.Clear
    Set otbl = Application.ActiveWindow.Selection.ShapeRange(1).Table
    If Not otbl Is Nothing Then
        For iRow = 1 To otbl.Rows.Count
            For iCol = 1 To otbl.Columns.Count
                If otbl.Cell(iRow, iCol).Selected Then
                    With otbl.Cell(iRow, iCol).Shape.TextFrame2
                        For I = 1 To .TextRange.Paragraphs.Count
                            With .TextRange.Paragraphs(I)
                                Select Case .ParagraphFormat.IndentLevel
                                Case Is = 1
                                    .ParagraphFormat.Alignment = ppAlignLeft
                                    .ParagraphFormat.FirstLineIndent = cm2Points(-0.5)
                                    .ParagraphFormat.LeftIndent = cm2Points(0.5)
                                    With .ParagraphFormat.Bullet
                                        .Visible = msoCTrue
                                        With .Font
                                            .Name = "Wingdings"
                                            .Size = 12
                                            .Fill.ForeColor.RGB = RGB(219, 0, 17)
                                        End With
                                        .Character = 167
                                    End With
                                    With .Font
                                        .Name = "Arial"
                                        .Size = 12
                                        .Bold = False
                                    End With
                                Case Is = 2
                                    .ParagraphFormat.Alignment = ppAlignLeft
                                    .ParagraphFormat.FirstLineIndent = cm2Points(-0.5)
                                    .ParagraphFormat.LeftIndent = cm2Points(1)
                                    With .ParagraphFormat.Bullet
                                        .Visible = msoCTrue
                                        With .Font
                                            .Size = 12
                                            .Name = "Arial"
                                            .Fill.ForeColor.RGB = RGB(219, 0, 17)
                                        End With
                                        .Character = 8211
                                    End With
                                    With .Font
                                        .Name = "Arial"
                                        .Size = 12
                                        .Bold = False
                                    End With
                                Case Is = 3
                                    .ParagraphFormat.Alignment = ppAlignLeft
                                    .ParagraphFormat.FirstLineIndent = cm2Points(-0.5)
                                    .ParagraphFormat.LeftIndent = cm2Points(1.5)
                                    With .ParagraphFormat.Bullet
                                        .Visible = msoCTrue
                                        With .Font
                                            .Name = "Wingdings"
                                            .Size = 12
                                            .Fill.ForeColor.RGB = RGB(219, 0, 17)
                                        End With
                                        .Character = 167
                                    End With
                                    With .Font
                                        .Name = "Arial"
                                        .Size = 12
                                        .Bold = False
                                    End With
                                Case Is = 4
                                    .ParagraphFormat.Alignment = ppAlignLeft
                                    .ParagraphFormat.FirstLineIndent = cm2Points(-0.5)
                                    .ParagraphFormat.LeftIndent = cm2Points(2)
                                    With .ParagraphFormat.Bullet
                                        .Visible = msoCTrue
                                        With .Font
                                            .Name = "Arial"
                                            .Size = 12
                                            .Fill.ForeColor.RGB = RGB(219, 0, 17)
                                        End With
                                        .Character = 8211
                                    End With
                                    With .Font
                                        .Name = "Arial"
                                        .Size = "12"
                                        .Bold = False
                                    End With
                             End Select
                        End With
                        Next I
                        End With
                    End If    ' selected
                Next iCol
            Next iRow
        End If    ' Table selected
    End Sub


Function cm2Points(inVal As Single)
    cm2Points = inVal * 28.346
End Function

[RayKay]

Perfect, thank you !!!