Hallo zusammen,
ich habe folgende Aufgabenstellung.
Eine Matrix mit verschiedenen checkboxen(Auf sheet1) erzeugt wenn geklickt ein Rechteck auf einer Hintergrundgrafik (sheet2). Wenn die box nicht gecheckt ist soll das Rechteck verschwinden. Es gibt ca 62 Flächen die erzeugt und gelöscht werden wollen.
Bis jetzt habe ich es so versucht:
Option Explicit
Private Sub CheckBox24_Change()
Dim shapesID As Long
If CheckBox24.Value = 0 Then
Sheets("Sheet2").Select
ActiveSheet.Shapes(CLng(Sheets("Sheet1").CheckBox24.Caption)).Delete
'Selection.ShapeRange.Fill.Visible = msoFalse
'Shapes_markieren
'shapes_entfernen
Else
Sheets("Sheet2").Select
ActiveWindow.ScrollColumn = 1
ActiveSheet.Shapes.AddShape(msoShapeRectangle,
409.5, 113.25, 71.25, 36.75).Select
shapesID = ActiveSheet.Shapes.Count
Sheets("Sheet1").CheckBox24.Caption = shapesID
Selection.ShapeRange.Fill.ForeColor.SchemeColor =40
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.SchemeColor =40
Selection.ShapeRange.Fill.Transparency = 0.5
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle =
msoLineSolid
Selection.ShapeRange.Line.Style =
msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 36.75
Selection.ShapeRange.Width = 71.25
Selection.ShapeRange.Rotation = 0#
End If
End Sub
Allerdings bekomme ich ab und an folgende Fehlermeldung:
Laufzeitfehler -2147024809 (80070057)
Der Index der angegebenen Sammlung liegt außerhalb des zuläßigen Bereichs.
Hat jemand einen Lösungsvorschlag?
Grüße
-Kai
