Consulting

Results 1 to 6 of 6

Thread: Applying Bullet Levels to Text

  1. 12-19-2018, 02:59 AM #1
    RayKay
    RayKay is offline
    VBAX Contributor
    Joined
    Dec 2018
    Location
    South London
    Posts
    115
    Location

    Applying Bullet Levels to Text

    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
    Attached Files Attached Files
    Last edited by Paul_Hossler; 12-19-2018 at 05:40 AM. Reason: Added CODE tags - use the [#] icon
    Reply With Quote Reply With Quote
  2. 12-19-2018, 03:36 AM #2
    John Wilson
    John Wilson is offline
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,094
    Location
    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
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html
    Reply With Quote Reply With Quote
  3. 12-19-2018, 03:54 AM #3
    RayKay
    RayKay is offline
    VBAX Contributor
    Joined
    Dec 2018
    Location
    South London
    Posts
    115
    Location
    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
    Reply With Quote Reply With Quote
  4. 12-19-2018, 06:54 AM #4
    John Wilson
    John Wilson is offline
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,094
    Location
    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)
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html
    Reply With Quote Reply With Quote
  5. 12-19-2018, 07:09 AM #5
    RayKay
    RayKay is offline
    VBAX Contributor
    Joined
    Dec 2018
    Location
    South London
    Posts
    115
    Location
    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
    Reply With Quote Reply With Quote
  6. 12-22-2018, 02:34 AM #6
    StarPig
    StarPig is offline
    VBAX Regular
    Joined
    Dec 2018
    Posts
    24
    Location
    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]
    Reply With Quote Reply With Quote
« Previous Thread | Next Thread »

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

Forum Rules