RandomGerman
06-12-2015, 11:15 AM
Hi there,
I'm quite close to hit what I want my macros to do: They already work, but two details are not the way I want them to be, so any help is appreciated.
I defined three levels of text:
First is bold, without bullet, and on the far left of the text box
Second is plain, with a bullet, and a bit indented
Third is plain, with a different bullet, and a bit more indented
Each of my three similar macros takes care for one of these levels. When you select a whole shape, the macro handles all text the same way, when you select only parts of the text, it works only for these selected parts.
The two details are:
1. On the first click the macros for level 2 and 3 don't hit exactly the defined LeftMargin. But they do, as soon as you use one of the macros again for another paragraph. It is difficult to explain, best is, you have a look on my attachment and try what I suggested there in a box on the right.
2. Changes between bold and plain are only realized for the selection, not for the whole paragraph. This is quite logical as I didn't tell the macro to act on the whole paragraph, because I just don't know how.
Here comes the code:
Sub SetTextLevel1()
Dim trg As TextRange
On Error GoTo err
Set trg = ActiveWindow.Selection.TextRange
With trg
.IndentLevel = 1
.ParagraphFormat.Alignment = ppAlignLeft
With .Parent.Ruler
.Levels(1).FirstMargin = 0
.Levels(1).LeftMargin = 0
.Levels(2).FirstMargin = 9.9212536
.Levels(2).LeftMargin = 22.960615
.Levels(3).FirstMargin = 32.031476
.Levels(3).LeftMargin = 45.354302
End With
.ParagraphFormat.Bullet.Visible = msoFalse
With .Font
.Name = "Arial"
.Bold = msoTrue
.Color.RGB = RGB(0, 0, 0)
End With
End With
Exit Sub
err:
MsgBox "Please select text or a shape"
End Sub
Sub SetTextLevel2()
Dim trg As TextRange
On Error GoTo err
Set trg = ActiveWindow.Selection.TextRange
With trg
.ParagraphFormat.Alignment = ppAlignLeft
.IndentLevel = 2
With .Parent.Ruler
.Levels(1).FirstMargin = 0
.Levels(1).LeftMargin = 0
.Levels(2).FirstMargin = 9.9212536
.Levels(2).LeftMargin = 22.960615
.Levels(3).FirstMargin = 32.031476
.Levels(3).LeftMargin = 45.354302
End With
With .ParagraphFormat.Bullet
.Visible = msoTrue
.UseTextColor = msoFalse
.UseTextFont = msoFalse
.RelativeSize = 1
.Character = 8226
With .Font
.Color.RGB = RGB(9, 91, 164)
End With
End With
With .Font
.Name = "Arial"
.Bold = msoFalse
End With
End With
Exit Sub
err:
MsgBox "Please select text or a shape"
End Sub
Sub SetTextLevel3()
Dim trg As TextRange
On Error GoTo err
Set trg = ActiveWindow.Selection.TextRange
With trg
.ParagraphFormat.Alignment = ppAlignLeft
.IndentLevel = 3
With .Parent.Ruler
.Levels(1).FirstMargin = 0
.Levels(1).LeftMargin = 0
.Levels(2).FirstMargin = 9.9212536
.Levels(2).LeftMargin = 22.960615
.Levels(3).FirstMargin = 32.031476
.Levels(3).LeftMargin = 45.354302
End With
With .ParagraphFormat.Bullet
.Visible = msoTrue
.UseTextColor = msoFalse
.UseTextFont = msoFalse
.RelativeSize = 1
.Character = 8211
With .Font
.Color.RGB = RGB(9, 91, 164)
End With
End With
With .Font
.Name = "Arial"
.Bold = msoFalse
End With
End With
Exit Sub
err:
MsgBox "Please select text or a shape"
End Sub
And here is a document including the macro and a TextBox with suggestions what to try
13675
Thanks for an help!
I'm quite close to hit what I want my macros to do: They already work, but two details are not the way I want them to be, so any help is appreciated.
I defined three levels of text:
First is bold, without bullet, and on the far left of the text box
Second is plain, with a bullet, and a bit indented
Third is plain, with a different bullet, and a bit more indented
Each of my three similar macros takes care for one of these levels. When you select a whole shape, the macro handles all text the same way, when you select only parts of the text, it works only for these selected parts.
The two details are:
1. On the first click the macros for level 2 and 3 don't hit exactly the defined LeftMargin. But they do, as soon as you use one of the macros again for another paragraph. It is difficult to explain, best is, you have a look on my attachment and try what I suggested there in a box on the right.
2. Changes between bold and plain are only realized for the selection, not for the whole paragraph. This is quite logical as I didn't tell the macro to act on the whole paragraph, because I just don't know how.
Here comes the code:
Sub SetTextLevel1()
Dim trg As TextRange
On Error GoTo err
Set trg = ActiveWindow.Selection.TextRange
With trg
.IndentLevel = 1
.ParagraphFormat.Alignment = ppAlignLeft
With .Parent.Ruler
.Levels(1).FirstMargin = 0
.Levels(1).LeftMargin = 0
.Levels(2).FirstMargin = 9.9212536
.Levels(2).LeftMargin = 22.960615
.Levels(3).FirstMargin = 32.031476
.Levels(3).LeftMargin = 45.354302
End With
.ParagraphFormat.Bullet.Visible = msoFalse
With .Font
.Name = "Arial"
.Bold = msoTrue
.Color.RGB = RGB(0, 0, 0)
End With
End With
Exit Sub
err:
MsgBox "Please select text or a shape"
End Sub
Sub SetTextLevel2()
Dim trg As TextRange
On Error GoTo err
Set trg = ActiveWindow.Selection.TextRange
With trg
.ParagraphFormat.Alignment = ppAlignLeft
.IndentLevel = 2
With .Parent.Ruler
.Levels(1).FirstMargin = 0
.Levels(1).LeftMargin = 0
.Levels(2).FirstMargin = 9.9212536
.Levels(2).LeftMargin = 22.960615
.Levels(3).FirstMargin = 32.031476
.Levels(3).LeftMargin = 45.354302
End With
With .ParagraphFormat.Bullet
.Visible = msoTrue
.UseTextColor = msoFalse
.UseTextFont = msoFalse
.RelativeSize = 1
.Character = 8226
With .Font
.Color.RGB = RGB(9, 91, 164)
End With
End With
With .Font
.Name = "Arial"
.Bold = msoFalse
End With
End With
Exit Sub
err:
MsgBox "Please select text or a shape"
End Sub
Sub SetTextLevel3()
Dim trg As TextRange
On Error GoTo err
Set trg = ActiveWindow.Selection.TextRange
With trg
.ParagraphFormat.Alignment = ppAlignLeft
.IndentLevel = 3
With .Parent.Ruler
.Levels(1).FirstMargin = 0
.Levels(1).LeftMargin = 0
.Levels(2).FirstMargin = 9.9212536
.Levels(2).LeftMargin = 22.960615
.Levels(3).FirstMargin = 32.031476
.Levels(3).LeftMargin = 45.354302
End With
With .ParagraphFormat.Bullet
.Visible = msoTrue
.UseTextColor = msoFalse
.UseTextFont = msoFalse
.RelativeSize = 1
.Character = 8211
With .Font
.Color.RGB = RGB(9, 91, 164)
End With
End With
With .Font
.Name = "Arial"
.Bold = msoFalse
End With
End With
Exit Sub
err:
MsgBox "Please select text or a shape"
End Sub
And here is a document including the macro and a TextBox with suggestions what to try
13675
Thanks for an help!