PDA

View Full Version : [SOLVED:] Error Message for object not selected



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

John Wilson
01-03-2019, 10:53 AM
Something based on this


Sub BulletText()
Dim L As Long
Dim oshp As Shape
On Error GoTo err
Set oshp = ActiveWindow.Selection.ShapeRange(1)
If oshp.Type <> msoTextBox Then GoTo err2


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
Exit Sub 'usual exit
err:
MsgBox "Please select something."
Exit Sub
err2:
MsgBox "Select a TEXTBOX"
End Sub


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

John Wilson
01-03-2019, 11:25 AM
Something based on this


Sub BulletText()
Dim L As Long
Dim oshp As Shape
On Error GoTo err
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
Exit Sub 'usual exit
err:
MsgBox "Please select a textbox"
End Sub


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