Sub ListeShapes()
Dim Sh As Shape
For Each Sh In ActiveSheet.Shapes
If Sh.Name Like "Group*" And Not Sh.Name Like "Group Box*" Then
Sh.Ungroup
End If
Next
For Each Sh In ActiveSheet.Shapes
If Not Sh.Name Like "Group*" Then
Sh.Select
ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0).Value = Sh.TopLeftCell.Address
ActiveSheet.Range("A65536").End(xlUp).Offset(0, 2).Value = Sh.Name
ActiveSheet.Range("A65536").End(xlUp).Offset(0, 3).Value = Selection.Value
ActiveSheet.Range("A65536").End(xlUp).Offset(0, 4).Value = Sh.AlternativeText
End If
Next
End Sub