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