Der Sepp hat mir ne prima Listbox erstellt, kann man diese so anpassen, das man Rubriken hat?
Thema1
"Kontrollkästchen" Thema1
"Kontrollkästchen" Thema2
"Kontrollkästchen" Thema3
......
.....
Thema 2
"Kontrollkästchen" Thema1
"Kontrollkästchen" Thema2
"Kontrollkästchen" Thema3
"Kontrollkästchen" Thema4
.....
....
usw.
Hier mal der verwendete Code:
Private Sub cmdOK_Click()
Dim lngI As Long, lngNext As Long, lngRow As Long, lngCol As Long
Dim rng1 As Range, rng2 As Range, rng3 As Range, rng As Range
With Sheets("Listbox1")
For lngI = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(lngI) Then
If rng1 Is Nothing Then
Set rng1 = .Cells(lngI + 1, 1)
Else
Set rng1 = Union(rng1, .Cells(lngI + 1, 1))
End If
End If
Next
End With
With Sheets("Listbox2")
For lngI = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(lngI) Then
If rng2 Is Nothing Then
Set rng2 = .Cells(lngI + 1, 1)
Else
Set rng2 = Union(rng2, .Cells(lngI + 1, 1))
End If
End If
Next
End With
With Sheets("Listbox3")
For lngI = 0 To ListBox3.ListCount - 1
If ListBox3.Selected(lngI) Then
If rng3 Is Nothing Then
Set rng3 = .Cells(lngI + 1, 1)
Else
Set rng3 = Union(rng3, .Cells(lngI + 1, 1))
End If
End If
Next
End With
With Sheets("Drucken")
.Range("G40:AZ45").ClearContents
If Not rng1 Is Nothing Then
lngRow = 40
lngCol = 7
For Each rng In rng1
.Cells(lngRow, lngCol) = rng.Value
lngRow = lngRow + 1
If lngRow > 45 Then
lngRow = 40
lngCol = lngCol + 17
End If
Next
End If
.Range("G31:AZ36").ClearContents
If Not rng2 Is Nothing Then
lngRow = 31
lngCol = 7
For Each rng In rng2
.Cells(lngRow, lngCol) = rng.Value
lngRow = lngRow + 1
If lngRow > 36 Then
lngRow = 31
lngCol = lngCol + 17
End If
Next
End If
.Range("G49:AZ55").ClearContents
If Not rng3 Is Nothing Then
lngRow = 49
lngCol = 7
For Each rng In rng3
.Cells(lngRow, lngCol) = rng.Value
lngRow = lngRow + 1
If lngRow > 55 Then
lngRow = 49
lngCol = lngCol + 17
End If
Next
End If
Unload Me
End With
Set rng1 = Nothing
Set rng2 = Nothing
Set rng3 = Nothing
End Sub