1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110
| Sub Bullets()
Dim oTbl As Table
Dim iRow As Integer
Dim iCol As Integer
Dim Ibullet As Integer
Dim oTR As TextRange2
Dim lngFirst As Long
Dim lngLeft As Long
Dim lngSecond As Long
Dim lngThird As Long
Dim lngLeft2 As Long
Dim lngLeft3 As Long
Dim boolBullet As Boolean
Dim k As Long
Dim l As Long
Dim M As Long
Dim Niveau As Long 'Indent Level
On Error Resume Next
Set oTbl = ActiveWindow.Selection.ShapeRange(1).Table
For I = 1 To oTbl.Rows.Count
For j = 1 To oTbl.Columns.Count
If oTbl.Cell(I, j).Selected Then
Set oTR = oTbl.Cell(I, j).Shape.TextFrame2.TextRange
For k = 1 To oTR.Paragraphs.Count
Niveau = oTR.Paragraphs(k).ParagraphFormat.IndentLevel
With oTbl.Cell(I, j).Shape.TextFrame
.Ruler.Levels(1).LeftMargin = 0 'Level 1
.Ruler.Levels(1).FirstMargin = 0 '
.Ruler.Levels(2).LeftMargin = 14.34 'Level 2
.Ruler.Levels(2).FirstMargin = 0 '
.Ruler.Levels(3).LeftMargin = 28.68 'Level 3
.Ruler.Levels(3).FirstMargin = 14.34 '
.Ruler.Levels(4).LeftMargin = 42.8 'Level 4
.Ruler.Levels(4).FirstMargin = 29.1 '
.Ruler.Levels(5).LeftMargin = 57.48 'Level 5
.Ruler.Levels(5).FirstMargin = 43.14 '
End With
With oTbl.Cell(I, j).Shape.TextFrame 'each paragraph is scanned
Select Case Niveau
Case 1 'If Indent = 0 level 1
.TextRange.Paragraphs(k).ParagraphFormat.Bullet.Type = ppBulletNone '= ppBulletUnnumbered 'Level 1
.TextRange.Paragraphs(k).ParagraphFormat.SpaceBefore = 0
.TextRange.Paragraphs(k).Font.Size = 10
Case 2 'If Indent = 2 level 2
.TextRange.Paragraphs(k).ParagraphFormat.Bullet.Type = ppBulletUnnumbered
.TextRange.Paragraphs(k).ParagraphFormat.SpaceBefore = 0
.TextRange.Paragraphs(k).ParagraphFormat.Bullet.Style = ppBulletAlphaLCParenBoth
.TextRange.Paragraphs(k).ParagraphFormat.Bullet.Font.Name = "Wingdings"
.TextRange.Paragraphs(k).Font.Size = 10
.TextRange.Paragraphs(k).ParagraphFormat.Bullet.Character = 110
.TextRange.Paragraphs(k).ParagraphFormat.Bullet.RelativeSize = 0.75
.TextRange.Paragraphs(k).ParagraphFormat.Bullet.Font.Color = RGB(14, 22, 85) 'Level 2
Case 3 'If Indent = 3 level 3
.TextRange.Paragraphs(k).ParagraphFormat.Bullet.Type = ppBulletUnnumbered
.TextRange.Paragraphs(k).ParagraphFormat.SpaceBefore = 0
.TextRange.Paragraphs(k).ParagraphFormat.Bullet.Style = ppBulletAlphaLCParenBoth
.TextRange.Paragraphs(k).ParagraphFormat.Bullet.Font.Name = "Wingdings"
.TextRange.Paragraphs(k).Font.Size = 10
.TextRange.Paragraphs(k).ParagraphFormat.Bullet.Character = 110
.TextRange.Paragraphs(k).ParagraphFormat.Bullet.RelativeSize = 0.75
.TextRange.Paragraphs(k).ParagraphFormat.Bullet.Font.Color = RGB(80, 80, 80) 'Level 3
Case 4 'If Indent = 4 level 4
.TextRange.Paragraphs(k).ParagraphFormat.Bullet.Type = ppBulletUnnumbered
.TextRange.Paragraphs(k).ParagraphFormat.SpaceBefore = 0
.TextRange.Paragraphs(k).ParagraphFormat.Bullet.Style = ppBulletAlphaLCParenBoth
.TextRange.Paragraphs(k).ParagraphFormat.Bullet.Font.Name = "symbol"
.TextRange.Paragraphs(k).Font.Size = 8
.TextRange.Paragraphs(k).ParagraphFormat.Bullet.Character = 45
.TextRange.Paragraphs(k).ParagraphFormat.Bullet.RelativeSize = 0.75
.TextRange.Paragraphs(k).ParagraphFormat.Bullet.Font.Color = RGB(0, 0, 0) 'Level 4
Case 5 'If Indent = 5 level 5
.TextRange.Paragraphs(k).ParagraphFormat.Bullet.Type = ppBulletUnnumbered
.TextRange.Paragraphs(k).ParagraphFormat.SpaceBefore = 0
.TextRange.Paragraphs(k).ParagraphFormat.Bullet.Style = ppBulletAlphaLCParenBoth
.TextRange.Paragraphs(k).ParagraphFormat.Bullet.Font.Name = "Wingdings"
.TextRange.Paragraphs(k).Font.Size = 8
.TextRange.Paragraphs(k).ParagraphFormat.Bullet.Character = 110
.TextRange.Paragraphs(k).ParagraphFormat.Bullet.RelativeSize = 0.75
.TextRange.Paragraphs(k).ParagraphFormat.Bullet.Font.Color = RGB(62, 54, 108) 'Level 5
Case Else
End Select
End With
Next k
With oTbl.Cell(I, j).Shape.TextFrame
.Ruler.Levels(1).LeftMargin = 0 'Level 1
.Ruler.Levels(1).FirstMargin = 0 '
.Ruler.Levels(2).LeftMargin = 14.34 'Level 2
.Ruler.Levels(2).FirstMargin = 0 '
.Ruler.Levels(3).LeftMargin = 28.68 'Level 3
.Ruler.Levels(3).FirstMargin = 14.34 '
.Ruler.Levels(4).LeftMargin = 42.8 'Level 4
.Ruler.Levels(4).FirstMargin = 29.1 '
.Ruler.Levels(5).LeftMargin = 43.14 'Level 5
.Ruler.Levels(5).FirstMargin = 57.48 '
End With
'oTR.Paragraphs(oTR.Paragraphs.Count).ParagraphFormat.IndentLevel
End If
Next j
Next I
End Sub |
Partager