Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1504to1508
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Über Button Kontrollkästchen abfragen

Über Button Kontrollkästchen abfragen
14.07.2016 08:48:29
Gero

Hallo Liebe User,
Ich habe eine spezielle Frage. Wie man dem Bild entnehmen kann habe ich eine menge Checkboxen. Es sind auch noch mehr als auf dem Bild zu sehen sind. Ich würde gerne über einen CommandButton eine Abfrage machen.
Und zwar soll er bei jeder Checkbox (die jeweils unter der 1 steht) gucken ob diese aktiviert ist. Wenn diese aktiviert ist soll der Text der über den Zahlen 1-8 steht in eine gewisse Zelle übernommen werden. Folgender Code funktioniert super....ABER--> es wäre sehr viel Arbeit jede Checkbox einzeln abzufragen. Kennt jmd. eine Vereinfachung?
Vielen Dank für Eure Hilfe
Private Sub CommandButton3_Click()
If CheckBox33.Value = True Then
Sheets("Tabelle1").Range("b5").Value = "Gesundheitsschädigende Wirkung von Gasen. Dämpfen,  _
Aerosolen, Stäuben"
Else: Sheets("Tabelle1").Range("b5").Value = "":
End If
If CheckBox1.Value = True Then
Sheets("Tabelle1").Range("b1").Value = "Ungeschützte bewegte Maschinenteile"
Else: Sheets("Tabelle1").Range("b1").Value = "":
End If
End Sub

Userbild

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Über Button Kontrollkästchen abfragen
14.07.2016 09:38:41
baschti007
Sind die Checkboxen mit der Zelle wo sie sind verlinkt ?
Lad am besten mal ne Beispiel Datei hoch.
Gruß basti

AW: Über Button Kontrollkästchen abfragen
14.07.2016 11:29:51
baschti007
Hier guck mal so hab den Code von Beverly etwas geändert geht bestimmt noch einfacher aber fürs erste.
Den rest musst du mal selber gucken wie genau du das wolltest
Gruß Basti
Sub Abfrage()
Dim Tab2 As Worksheet
Dim Tab1 As Worksheet
Set Tab1 = Worksheets(1)
Set Tab2 = Worksheets(2)
Tab2.Cells.Clear
Dim oobBox As OLEObject
For Each oobBox In Tab1.OLEObjects
If oobBox.progID = "Forms.CheckBox.1" Then
If Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0) = 1 And oobBox.Object.Value  _
= True Then Tab2.Cells(1 + Tab2.Cells(1048576, 1).End(xlUp).Row, 1) = Range(oobBox.TopLeftCell.Address).Offset(-2, 0)
If Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0) = 2 And oobBox.Object.Value  _
= True Then Tab2.Cells(1 + Tab2.Cells(1048576, 2).End(xlUp).Row, 2) = Range(oobBox.TopLeftCell.Address).Offset(-2, -1)
If Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0) = 3 And oobBox.Object.Value  _
= True Then Tab2.Cells(1 + Tab2.Cells(1048576, 3).End(xlUp).Row, 3) = Range(oobBox.TopLeftCell.Address).Offset(-2, -2)
If Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0) = 4 And oobBox.Object.Value  _
= True Then Tab2.Cells(1 + Tab2.Cells(1048576, 4).End(xlUp).Row, 4) = Range(oobBox.TopLeftCell.Address).Offset(-2, -3)
If Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0) = 5 And oobBox.Object.Value  _
= True Then Tab2.Cells(1 + Tab2.Cells(1048576, 5).End(xlUp).Row, 5) = Range(oobBox.TopLeftCell.Address).Offset(-2, -4)
If Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0) = 6 And oobBox.Object.Value  _
= True Then Tab2.Cells(1 + Tab2.Cells(1048576, 6).End(xlUp).Row, 6) = Range(oobBox.TopLeftCell.Address).Offset(-2, -5)
If Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0) = 7 And oobBox.Object.Value  _
= True Then Tab2.Cells(1 + Tab2.Cells(1048576, 7).End(xlUp).Row, 7) = Range(oobBox.TopLeftCell.Address).Offset(-2, -6)
If Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0) = 8 And oobBox.Object.Value  _
= True Then Tab2.Cells(1 + Tab2.Cells(1048576, 8).End(xlUp).Row, 8) = Range(oobBox.TopLeftCell.Address).Offset(-2, -7)
End If
Next oobBox
End Sub

Anzeige
AW: Über Button Kontrollkästchen abfragen
14.07.2016 11:41:51
Gero
Mega Vielen Lieben Dank....Echt toll wie schnell das geklappt hat...Versuche jetzt mal genau zu verstehen was jeder schritt macht um ihn auf meine gesamte Tabelle anzuwenden.....aber so ist es genau wie ich es wollte

AW: Über Button Kontrollkästchen abfragen
14.07.2016 14:51:58
Gero
Dein code ist echt hammer....jetzt nur eine frage...ist es auch möglich das alles so bleibt wie jetzt und nur die dritte (rosa spalte) wo anders ausgegeben wird(zum Beispiel spalte i quasi hinter der letzten h)

AW: Über Button Kontrollkästchen abfragen
14.07.2016 15:33:20
baschti007
Also ich hab es so verstanden das rosa boxen erst ab Spalte i ausgewertet werden sollen ?
ob das so richtig ist musst du mal gucken
Gruß Basti
Sub Abfrage()
Dim Tab2 As Worksheet
Dim Tab1 As Worksheet
Set Tab1 = Worksheets(1)
Set Tab2 = Worksheets(2)
Tab2.Cells.Clear
Dim oobBox As OLEObject
For Each oobBox In Tab1.OLEObjects
If oobBox.progID = "Forms.CheckBox.1" Then
'MsgBox Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0).Interior.ColorIndex
If Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0) = 1 And oobBox.Object.Value  _
= True And Not Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0).Interior.ColorIndex = 39 Then Tab2.Cells(1 + Tab2.Cells(1048576, 1).End(xlUp).Row, 1) = Range(oobBox.TopLeftCell.Address).Offset(-2, 0): GoTo x
If Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0) = 2 And oobBox.Object.Value  _
= True And Not Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0).Interior.ColorIndex = 39 Then Tab2.Cells(1 + Tab2.Cells(1048576, 2).End(xlUp).Row, 2) = Range(oobBox.TopLeftCell.Address).Offset(-2, -1): GoTo x
If Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0) = 3 And oobBox.Object.Value  _
= True And Not Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0).Interior.ColorIndex = 39 Then Tab2.Cells(1 + Tab2.Cells(1048576, 3).End(xlUp).Row, 3) = Range(oobBox.TopLeftCell.Address).Offset(-2, -2): GoTo x
If Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0) = 4 And oobBox.Object.Value  _
= True And Not Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0).Interior.ColorIndex = 39 Then Tab2.Cells(1 + Tab2.Cells(1048576, 4).End(xlUp).Row, 4) = Range(oobBox.TopLeftCell.Address).Offset(-2, -3): GoTo x
If Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0) = 5 And oobBox.Object.Value  _
= True And Not Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0).Interior.ColorIndex = 39 Then Tab2.Cells(1 + Tab2.Cells(1048576, 5).End(xlUp).Row, 5) = Range(oobBox.TopLeftCell.Address).Offset(-2, -4): GoTo x
If Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0) = 6 And oobBox.Object.Value  _
= True And Not Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0).Interior.ColorIndex = 39 Then Tab2.Cells(1 + Tab2.Cells(1048576, 6).End(xlUp).Row, 6) = Range(oobBox.TopLeftCell.Address).Offset(-2, -5): GoTo x
If Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0) = 7 And oobBox.Object.Value  _
= True And Not Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0).Interior.ColorIndex = 39 Then Tab2.Cells(1 + Tab2.Cells(1048576, 7).End(xlUp).Row, 7) = Range(oobBox.TopLeftCell.Address).Offset(-2, -6): GoTo x
If Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0) = 8 And oobBox.Object.Value  _
= True And Not Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0).Interior.ColorIndex = 39 Then Tab2.Cells(1 + Tab2.Cells(1048576, 8).End(xlUp).Row, 8) = Range(oobBox.TopLeftCell.Address).Offset(-2, -7): GoTo x
If Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0) = 1 And oobBox.Object.Value  _
= True And Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0).Interior.ColorIndex = 39 Then Tab2.Cells(1 + Tab2.Cells(1048576, 1 + 8).End(xlUp).Row, 1 + 8) = Range(oobBox.TopLeftCell.Address).Offset(-2, 0): GoTo x
If Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0) = 2 And oobBox.Object.Value  _
= True And Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0).Interior.ColorIndex = 39 Then Tab2.Cells(1 + Tab2.Cells(1048576, 2 + 8).End(xlUp).Row, 2 + 8) = Range(oobBox.TopLeftCell.Address).Offset(-2, -1): GoTo x
If Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0) = 3 And oobBox.Object.Value  _
= True And Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0).Interior.ColorIndex = 39 Then Tab2.Cells(1 + Tab2.Cells(1048576, 3 + 8).End(xlUp).Row, 3 + 8) = Range(oobBox.TopLeftCell.Address).Offset(-2, -2): GoTo x
If Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0) = 4 And oobBox.Object.Value  _
= True And Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0).Interior.ColorIndex = 39 Then Tab2.Cells(1 + Tab2.Cells(1048576, 4 + 8).End(xlUp).Row, 4 + 8) = Range(oobBox.TopLeftCell.Address).Offset(-2, -3): GoTo x
If Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0) = 5 And oobBox.Object.Value  _
= True And Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0).Interior.ColorIndex = 39 Then Tab2.Cells(1 + Tab2.Cells(1048576, 5 + 8).End(xlUp).Row, 5 + 8) = Range(oobBox.TopLeftCell.Address).Offset(-2, -4): GoTo x
If Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0) = 6 And oobBox.Object.Value  _
= True And Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0).Interior.ColorIndex = 39 Then Tab2.Cells(1 + Tab2.Cells(1048576, 6 + 8).End(xlUp).Row, 6 + 8) = Range(oobBox.TopLeftCell.Address).Offset(-2, -5): GoTo x
If Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0) = 7 And oobBox.Object.Value  _
= True And Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0).Interior.ColorIndex = 39 Then Tab2.Cells(1 + Tab2.Cells(1048576, 7 + 8).End(xlUp).Row, 7 + 8) = Range(oobBox.TopLeftCell.Address).Offset(-2, -6): GoTo x
If Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0) = 8 And oobBox.Object.Value  _
= True And Tab1.Range(oobBox.TopLeftCell.Address).Offset(-1, 0).Interior.ColorIndex = 39 Then Tab2.Cells(1 + Tab2.Cells(1048576, 8 + 8).End(xlUp).Row, 8 + 8) = Range(oobBox.TopLeftCell.Address).Offset(-2, -7): GoTo x
End If
x:
Next oobBox
End Sub

Anzeige
AW: Über Button Kontrollkästchen abfragen
18.07.2016 08:45:11
Gero
Genau so....sorry das ich mich jetzt erst melde. Und nochmals vielen vielen lieben Dank
Hast mir sehr geholfen....und Respekt für die Formel
AW: Über Button Kontrollkästchen abfragen
18.07.2016 13:15:21
baschti007
Kein Problem =) aber meine Formel ist auch nicht gut aber sie geht ;) kann man auch noch viel kürzer und schneller machen.
Gruß Basti

AW: Über Button Kontrollkästchen abfragen
14.07.2016 09:44:34
Beverly
Hi Gero,
eventuell nach diesem Prinzip:
Sub Abfrage()
Dim oobBox As OLEObject
For Each oobBox In ActiveSheet.OLEObjects
If oobBox.progID = "Forms.CheckBox.1" Then
If Range(oobBox.TopLeftCell.Address).Offset(-1, 0) = 1 Then
If oobBox.Object.Value = True Then
' hier dein Code was gemacht werden soll wenn aktiviert
Else
' hier dein Code was gemacht werden soll wenn nicht aktiviert
End If
End If
End If
Next oobBox
End Sub

Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige