RayKay
01-03-2019, 09:29 AM
Hi John
Recently you helped with the below code.
If a person hasn't clicked a text box (or put their cursor in the text), I'd like a popup saying "PLEASE SELECT YOUR TEXT BOX", rather than the ugly VBA default error box (that says Debug etc).
I've tried various err Msg VBA, but I'm stumped.
Thank you :)
Code:
Sub BulletText()
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)
End Select
Next L
End With
End If
End If
End Sub
Function cm2Points(inVal As Single)
cm2Points = inVal * 28.346
End Function
Recently you helped with the below code.
If a person hasn't clicked a text box (or put their cursor in the text), I'd like a popup saying "PLEASE SELECT YOUR TEXT BOX", rather than the ugly VBA default error box (that says Debug etc).
I've tried various err Msg VBA, but I'm stumped.
Thank you :)
Code:
Sub BulletText()
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)
End Select
Next L
End With
End If
End If
End Sub
Function cm2Points(inVal As Single)
cm2Points = inVal * 28.346
End Function