Sub tryIt()
Dim myStrg As String
Dim maxlen As Long
Dim Source As Worksheet
Dim c As Range
Dim x As Long
Sheets(1).Select
If ActiveSheet.Shapes.Count > 0 Then
For x = ActiveSheet.Shapes.Count To 1 Step -1
ActiveSheet.Shapes(x).Delete
Next x
End If
Set c = Selection
Set Source = Sheets("Auswertung")
With Source
maxlen = WorksheetFunction.Max(Len(Format(.[C6], .[C6].NumberFormat)), _
Len(Format(.[C7], .[C7].NumberFormat)))
myStrg = myStrg & .[A6] & " :" & vbTab
If IsNumeric(.[C6]) Or IsNumeric(.[C7]) Then
myStrg = myStrg & _
Right(String(maxlen, Chr(32)) & Format(.[C6], .[C6].NumberFormat), maxlen) & Chr(10)
Else
myStrg = myStrg & .[C6] & Chr(10)
End If
myStrg = myStrg & .[A7] & " :" & vbTab
If IsNumeric(.[C7]) Or IsNumeric(.[C6]) Then
myStrg = myStrg & _
Right(String(maxlen, Chr(32)) & Format(.[C7], .[C7].NumberFormat), maxlen) & Chr(10)
Else
myStrg = myStrg & .[C7]
End If
End With
ActiveSheet.Shapes.AddTextbox(1, 300, 200, 200, 35).Select
With Selection.ShapeRange
.TextFrame.Characters.Font.Name = "Lucida Console"
.TextFrame.Characters.Font.Size = 10
.TextFrame.Characters.Text = myStrg
End With
c.Select
End Sub