VisualBasic VBA Erstellung von Checkboxen in einem Tabellenblatt und Wertezuweisung

mikelsdump

Cadet 4th Year
Registriert
Aug. 2008
Beiträge
123
Hallo zusammen,

ich habe eine Tabelle mit Angaben der Leistung von Atomkraftwerken. In jede Zeile (also zu jedem AKW) soll eine Checkbox hinzukommen. Wenn die checkbox einen Haken hat bedeutet das, dass das AKW aktiv ist, ansonsten nicht. In einem weiteren Tabellenfeld sollen die Leistungen (in kWh) von allen Kraftwerken berechnet werden, die (durch den Haken) als aktiv markiert sind.

Meine Vorgehensweise war wie folgt angedacht: Ich erzeuge mit dem Sub MH erstmal die Checkboxen in den Zeilen 2-18. Mit dem Sub Mi() schreibe ich die jeweiligen kWh-Werte in einen Array v. An der STelle unten bei
Code:
ELSE v(i)=0
bekomme ich jedoch die Fehlermeldung "Runtime error 9: Subscript out of range".

Kann mir jemand weiterhelfen was hier der Fehler ist? Ganzer Code:

Code:
Sub MH()
Dim Zelle As String
Dim i As Integer

'Checkboxen erstellen
For i = 2 To 18 Step 1
Zelle = "D" & i
With Range(Zelle)
    Set objCheckBox = ActiveSheet.OLEObjects.Add _
        (ClassType:="Forms.CheckBox.1", Link:=False, _
        DisplayAsIcon:=False, Left:=.Left, Top:=.Top, Width:=.Width, _
        Height:=.Height).Object
     End With
Next i



End Sub


Sub Mi()

Dim v(), i As Integer

For i = 2 To 18 Step 1

If Worksheets("Tabelle1").OLEObjects("Checkbox" & i).Object.Value = True Then
v(i) = Cells(i + 1, 2)
Else
v(i) = 0
End If
Next i

End Sub
 
Mit v() hast du ein Array mit der Größe 0 (Achtung nullbasiert) deklariert, greifst aber in deiner Schleife sofort auf die Stelle v(2) zu welche ja nicht existiert.
D.h. du musst erstmal die Größe deines Arrays festsetzen damit du auch auf dieses zugreifen kannst:
Redim v(x) bzw. Redim Preserve v(x)
 
Nachdem ich nun zu Beginn der Schleife ein
PHP:
Redim Preserve v(i)
Hinzugefügt habe, bringt er mir plötzlich in der If-Zeile die Debugger-Meldung "Runtime Error 1004: Unable to get the OLEObjects property of the worksheet class"

:confused_alt:
 
D.h. lediglich du hast einen Fehler behoben aber es gibt noch weitere ;)

Nebenbei solltest du bedenken, dass ein Redim Preserve vergleichsweise viel Rechenzeit in Anspruch nimmt wenn du viele Einträge hast.
Daher solltest du, wenn du von vorne herein weißt wieviele Elemente du hast diese auch schon festlegen.
In deinem Fall hast du immer die Elemente 2 bis 18, also wäre ein Redim v(2 to 18) vor der Schleife sinnvoller.

Bezüglich der neuen Fehlermeldung:
Bist du dir sicher das deine "Tabelle1" auch OLEObjects enhält?
 
Naja, dass da jetzt ein Fehler auftaucht verwundert mich, denn zuvor hatte ich den Befehl einzeln gemacht, also
Code:
Sub CheckBox1_Click()
If Worksheets("Tabelle1").OLEObjects("Checkbox1").Object.Value = True Then
C1 = Cells(2, 2)
Else
C1 = 0
End If
End Sub
und da kam keine Fehlermeldung.

Dass ich OLE-Objekte in der Tabelle habe bin ich mir sicher. Habe das ja in der ersten Schleife veranlasst, dass in jede Zeile ein OLE-Objekt Typ checkbox reingehauen wird. Die Checkboxen sind auch de facto auf dem Tabellenblatt..
 
Der Unterschied ist aber, dass du jetzt eine Schleife durchläufst und nacheinander mehrere OLEObjects ansprichst, eventuell ist eines dieser nicht vorhanden oder Excel kommt dir einfach nicht mehr nach.
Versuche mal das Worksheet in einer Variable zu speichern statt es ständig über die Worksheets neu zu holen.
Ansonsten kannst du vor deiner Abfrage ob die Checkbox markiert ist oder nicht erstmal kontrollieren ob es das Objekt überhaupt gibt.
 
Versuche mal das Worksheet in einer Variable zu speichern statt es ständig über die Worksheets neu zu holen.
Ansonsten kannst du vor deiner Abfrage ob die Checkbox markiert ist oder nicht erstmal kontrollieren ob es das Objekt überhaupt gibt.

Wie kann ich das machen? Bin Neueinsteiger...
 
Also du versuchst auf das OLEObject "Checkbox18" zuzugreifen welches es nicht gibt, deine Funktion erstellt nur die Objekte "Checkbox1-17".
Ich würde es so machen:
Code:
Sub Mi()
 
    Dim ws As Worksheet
    Dim v As Variant
    Dim i As Integer
    
    Set ws = Worksheets("Tabelle1")
    ReDim v(2 To 18)
    
    i = 2
    For Each obj In ws.OLEObjects
        If obj.Object.Value = True Then
            v(i) = ws.Cells(i + 1, 2)
        Else
            v(i) = 0
        End If
        i = i + 1
    Next
 
End Sub
 
Danke für deine Unterstützung. Der Fehler lag allerdings an etwas weit simplerem: Ich habe mein Office erst vor einigen Tagen installiert. Und bis heute war mir nicht aufgefallen, dass es komplett auf englisch ist, und daher das worksheet nicht "Tabelle1" sondern "sheet1" heißt...:D
 
Zurück
Oben