Applying Bullet Levels to Text

[RayKay]

Hi, I have edited this code below, but when I format the text, the second level bullets don't indent to 0.5cm and 1.0cm (nicely aligned, so the 2nd level bullet starts under the text starting for Level 1 bullets). Also, I wish it affected a selected text box (and not have to select the text within the text box). Almost there :)
Thank you.

Code:


Sub BulletText10()
With Application.ActiveWindow.Selection
If .Type = ppSelectionText Then
i = 1
For i = 1 To .TextRange.Paragraphs.Count
With .TextRange.Paragraphs(Start:=i, Length:=1)
Select Case .IndentLevel
Case Is = 1
.ParagraphFormat.Alignment = ppAlignLeft
.Parent.Ruler.Levels(i).FirstMargin = 0
.Parent.Ruler.Levels(i).LeftMargin = 15
With .ParagraphFormat.Bullet
.Visible = msoCTrue
With .Font
.Name = "Wingdings"
.Color.RGB = RGB(219, 0, 17)
End With
.Character = 167
End With
Case Is = 2
.ParagraphFormat.Alignment = ppAlignLeft
.Parent.Ruler.Levels(i).FirstMargin = 16
.Parent.Ruler.Levels(i).LeftMargin = 31
With .ParagraphFormat.Bullet
.Visible = msoCTrue
With .Font
.Name = "Arial"
.Color.RGB = RGB(219, 0, 17)
End With
.Character = 8211
End With
Case Is = 3
.ParagraphFormat.Alignment = ppAlignLeft
.Parent.Ruler.Levels(i).FirstMargin = 32
.Parent.Ruler.Levels(i).LeftMargin = 47
With .ParagraphFormat.Bullet
.Visible = msoCTrue
With .Font
.Name = "Wingdings"
.Color.RGB = RGB(219, 0, 17)
End With
.Character = 167
.RelativeSize = 0.9
End With
End Select
End With
Next i
End If
End With
End Sub

[John Wilson]

You are using legacy code from version 2003 and earlier. Later versions do not use the ruler in this way.

You should set the \LEFT INDENT and then set the FIRSTLINEINDENT to 0.5 cm BACK


Sub IndentM() Dim L As Long
Dim oshp As Shape
Set oshp = ActiveWindow.Selection.ShapeRange(1)
If oshp.HasTextFrame Then
If oshp.TextFrame2.HasText Then
With oshp.TextFrame2.TextRange
For L = 1 To .Paragraphs.Count
Select Case .Paragraphs(L).ParagraphFormat.IndentLevel
Case Is = 1
' note the FirstLine Indent is constant
.Paragraphs(L).ParagraphFormat.FirstLineIndent = cm2Points(-0.5)
.Paragraphs(L).ParagraphFormat.LeftIndent = cm2Points(0.5)
Case Is = 2
.Paragraphs(L).ParagraphFormat.FirstLineIndent = cm2Points(-0.5)
.Paragraphs(L).ParagraphFormat.LeftIndent = cm2Points(1#)
Case Is = 3
.Paragraphs(L).ParagraphFormat.FirstLineIndent = cm2Points(-0.5)
.Paragraphs(L).ParagraphFormat.LeftIndent = cm2Points(1.5)
End Select
Next L
End With
End If
End If
End Sub


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

[RayKay]

Fantastic John. Your intelligence is outstanding. Just one change, can it carry over the bullets?
I've attached a PowerPoint slide to my first thread explaining visually. Thank you.

My code for bullets and levels are within this code, sorry I'm not much help, I really hope I'm not using up your time, and I hope thousands of visitors find this code (once altered) useful :)


With Application.ActiveWindow.Selection
If .Type = ppSelectionText Then
I = 1
For I = 1 To .TextRange.Paragraphs.Count
With .TextRange.Paragraphs(Start:=I, Length:=1)
Select Case .IndentLevel
Case Is = 1
.ParagraphFormat.Alignment = ppAlignLeft
.Parent.Ruler.Levels(I).FirstMargin = 0
.Parent.Ruler.Levels(I).LeftMargin = 15
With .ParagraphFormat.Bullet
.Visible = msoCTrue
With .Font
.Name = "Wingdings"
.Color.RGB = RGB(219, 0, 17)
End With
.Character = 167
End With
Case Is = 2
.ParagraphFormat.Alignment = ppAlignLeft
.Parent.Ruler.Levels(I).FirstMargin = 16
.Parent.Ruler.Levels(I).LeftMargin = 31
With .ParagraphFormat.Bullet
.Visible = msoCTrue
With .Font
.Name = "Arial"
.Color.RGB = RGB(219, 0, 17)
End With
.Character = 8211
End With
Case Is = 3
.ParagraphFormat.Alignment = ppAlignLeft
.Parent.Ruler.Levels(I).FirstMargin = 32
.Parent.Ruler.Levels(I).LeftMargin = 47
With .ParagraphFormat.Bullet
.Visible = msoCTrue
With .Font
.Name = "Wingdings"
.Color.RGB = RGB(219, 0, 17)
End With
.Character = 167
.RelativeSize = 0.9

[John Wilson]

This is how you adapt L1 to a red rectangle bullet. I'll leave you to work out the other levels!


Case Is = 1' note the FirstLine Indent is constant
.Paragraphs(L).ParagraphFormat.FirstLineIndent = cm2Points(-0.5)
.Paragraphs(L).ParagraphFormat.LeftIndent = cm2Points(0.5)
.Paragraphs(L).ParagraphFormat.Bullet.Font.Name = "WingDings"
.Paragraphs(L).ParagraphFormat.Bullet.Character = 167
.Paragraphs(L).ParagraphFormat.Bullet.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)

[RayKay]

Perfect, thank you!!!! And code for others:

Sub BulletText10()
Dim L As Long
Dim oshp As Shape
Set oshp = ActiveWindow.Selection.ShapeRange(1)
If oshp.HasTextFrame Then
If oshp.TextFrame2.HasText Then
With oshp.TextFrame2.TextRange
For L = 1 To .Paragraphs.Count
Select Case .Paragraphs(L).ParagraphFormat.IndentLevel
Case Is = 1 ' note the FirstLine Indent is constant
.Paragraphs(L).ParagraphFormat.FirstLineIndent = cm2Points(-0.5)
.Paragraphs(L).ParagraphFormat.LeftIndent = cm2Points(0.5)
.Paragraphs(L).ParagraphFormat.Bullet.Font.Name = "WingDings"
.Paragraphs(L).ParagraphFormat.Bullet.Character = 167
.Paragraphs(L).ParagraphFormat.Bullet.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)


Case Is = 2
.Paragraphs(L).ParagraphFormat.FirstLineIndent = cm2Points(-0.5)
.Paragraphs(L).ParagraphFormat.LeftIndent = cm2Points(1#)
.Paragraphs(L).ParagraphFormat.Bullet.Font.Name = "Arial"
.Paragraphs(L).ParagraphFormat.Bullet.Character = 8211
.Paragraphs(L).ParagraphFormat.Bullet.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)


Case Is = 3
.Paragraphs(L).ParagraphFormat.FirstLineIndent = cm2Points(-0.5)
.Paragraphs(L).ParagraphFormat.LeftIndent = cm2Points(1.5)
.Paragraphs(L).ParagraphFormat.Bullet.Font.Name = "WingDings"
.Paragraphs(L).ParagraphFormat.Bullet.Character = 167
.Paragraphs(L).ParagraphFormat.Bullet.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)


End Select
Next L
End With
End If
End If
End Sub




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

[StarPig]

With the below code - it does not work in tables - any chance to adapt to work in tables? maybe selecting cells or text in cells if that does not work?
Superb website. Thank you.



Sub IndentM() Dim L As Long
Dim oshp As Shape
Set oshp = ActiveWindow.Selection.ShapeRange(1)
If oshp.HasTextFrame Then
If oshp.TextFrame2.HasText Then
With oshp.TextFrame2.TextRange
For L = 1 To .Paragraphs.Count
Select Case .Paragraphs(L).ParagraphFormat.IndentLevel
Case Is = 1
' note the FirstLine Indent is constant
.Paragraphs(L).ParagraphFormat.FirstLineIndent = cm2Points(-0.5)
.Paragraphs(L).ParagraphFormat.LeftIndent = cm2Points(0.5)
Case Is = 2
.Paragraphs(L).ParagraphFormat.FirstLineIndent = cm2Points(-0.5)
.Paragraphs(L).ParagraphFormat.LeftIndent = cm2Points(1#)
Case Is = 3
.Paragraphs(L).ParagraphFormat.FirstLineIndent = cm2Points(-0.5)
.Paragraphs(L).ParagraphFormat.LeftIndent = cm2Points(1.5)
End Select
Next L
End With
End If
End If
End Sub


Function cm2Points(inVal As Single)
cm2Points = inVal * 28.346
End Function[/QUOTE]