Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next: [Select_Box].Delete: [Big_Text].Delete: On Error GoTo 0
Select Case True
Case Target.Count > 1
Case Target = ""
Case Else
With Shapes.AddShape(msoShapeRoundedRectangle, _
Target.Left - 5, Target.Top - 5, _
Target.Width + 10, Target.Height + 10)
.Name = "Select_Box"
.Fill.Visible = msoFalse
.Line.Visible = msoTrue
.Line.Weight = 1.5
.Line.ForeColor.RGB = vbRed
End With
With Shapes.AddShape(msoShapeLeftArrowCallout, _
[Select_Box].Left + [Select_Box].Width, [Select_Box].Top, _
200, 200)
.Name = "Big_Text"
.Fill.ForeColor.RGB = RGB(255, 255, 204)
With .TextFrame2
.VerticalAnchor = msoAnchorMiddle: .HorizontalAnchor = msoAnchorCenter
.MarginLeft = 1: .MarginRight = 1
.TextRange.Font.Bold = msoTrue
.TextRange.Font.Size = Target.Font.Size * 3
.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
.TextRange.Characters.Text = Target.Text
.WordWrap = msoFalse
.AutoSize = msoAutoSizeShapeToFitText
End With
.Adjustments.Item(4) = 0.85
.Top = [Select_Box].Top - (.Height - [Select_Box].Height) / 2
End With
End Select
End Sub