Private Sub AddShape()
Dim Found As Boolean
Dim SrchRng As Range
Dim cCol As Variant, cRow As Variant
Dim T, L As Integer
Dim H, W As Single
Dim shp As Excel.Shape
Dim i, j As Long
Set SrchRng = Worksheets("Lists").Range("D3").CurrentRegion
cRow = 3
cCol = 4
W = 160.5
H = 19.5
For Each c In SrchRng.Cells
Found = False
.................... an dieser Stelle soll positioniert werden ...........
Set shp = Worksheets("Checklist Structure").Shapes.AddShape(msoShapeRoundedRectangle, L, T, W, H)
With shp
.TextFrame2.TextRange.Characters.Text = c.Value
.Fill.ForeColor.RGB = RGB(255, 255, 255)
.TextFrame2.VerticalAnchor = msoAnchorMiddle
.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(112, 48, 160)
.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
.OnAction = "'" & ThisWorkbook.Name & "'!RoundedRectangleSubcategory_Click"
End With
Next
End Sub