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 !!!