Option Explicit
Public Sub Shape_OnAction()
If VarType(Application.Caller) <> vbString Then
Exit Sub
End If
Dim shp As Excel.Shape
On Error Resume Next
Set shp = ActiveSheet.Shapes(Application.Caller)
On Error GoTo 0
If shp Is Nothing Then
Exit Sub
End If
Dim wks As Excel.Worksheet
Dim strNewName As String
On Error GoTo Err_AddWorksheetFailed
Set wks = Worksheets.Add
On Error GoTo Err_RenameWorksheetFailed
strNewName = shp.TextFrame2.TextRange.Text
wks.Name = strNewName
On Error GoTo 0
Exit Sub
Err_AddWorksheetFailed:
Call MsgBox("Ein neues Tabellenblatt konnte nicht hinzugefügt werden.", vbCritical)
Exit Sub
Err_RenameWorksheetFailed:
Call MsgBox("Tabellenblatt '" & wks.Name & "' konnte nicht in '" & strNewName & "' umbenannt werden.", vbExclamation)
End Sub