Option Explicit
Public Sub Shape_OnAction()
Dim strShapeName As String
Dim strShapeText As String
Select Case TypeName(Application.Caller)
Case "String"
strShapeName = Application.Caller
Case Else
Exit Sub
End Select
If ShapeExists(strShapeName, ActiveSheet) Then
With ActiveSheet.Shapes(strShapeName)
strShapeText = .TextFrame2.TextRange.Text
End With
Call MsgBox("Shape = '" & strShapeName & "'" & vbNewLine & _
"Text = '" & strShapeText & "'")
Else
Call MsgBox("Shape '" & strShapeName & "' wurde im aktiven Blatt nicht gefunden.", _
vbExclamation)
End If
Exit Sub
ErrHandler:
Call MsgBox("Fehler: " & Err.Number & vbNewLine & vbNewLine & _
"Beschreibung: " & vbNewLine & _
Err.Description, _
Buttons:=vbCritical, _
Title:="Shape_OnClick")
End Sub
Public Function ShapeExists(Name As String, Optional Sheet As Object) As Boolean
On Error Resume Next
If Sheet Is Nothing Then
ShapeExists = (ActiveSheet.Shapes(Name).Name <> "")
Else
ShapeExists = (Sheet.Shapes(Name).Name <> "")
End If
End Function