code verkürzen
10.10.2005 09:52:50
Poseidon
ich habe folgenden code:
Private Sub cmdBestaetigen_Click()
Dim cntrl As Control
Dim chkboxzähler As Integer
Application.ScreenUpdating = False
For Each cntrl In Me.Controls
If TypeName(cntrl) = "CheckBox" Then
If cntrl Then chkboxzähler = chkboxzähler + 1
End If
Next
If chkboxzähler < 2 Then
MsgBox "Es wurde keine korrekte Auswahl getroffen." _
& vbCrLf & "Es müssen 2 Monate ausgewählt werden.", vbInformation +
vbOKOnly, "Ohne Auswahl kein Vergleich"
End If
If CheckBox1 = True Then
Worksheets("vergleich").Select
If Worksheets("vergleich").Range("B7") = "" Then
Range("B1:B3").Select
Selection.Copy
Range("B6").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
End If
End If
If CheckBox2 = True Then
Worksheets("vergleich").Select
If Worksheets("vergleich").Range("B7") = "" Then
Range("C1:C3").Select
Selection.Copy
Range("B6").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Else
Range("C1:C3").Select
Selection.Copy
Range("C6").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
End If
End If
If CheckBox3 = True Then
Worksheets("vergleich").Select
If Worksheets("vergleich").Range("B7") = "" Then
Range("D1:D3").Select
Selection.Copy
Range("B6").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Else
Range("D1:D3").Select
Selection.Copy
Range("C6").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
End If
End If
Unload Me
Worksheets("Menü").Select
Application.ScreenUpdating = True
DiagrammDarstellenMV.Show
End Sub
er funzt bestens, aber es kommen noch 9 weitere checkboxabfragen hinzu.
checkbox4 mit kopieren von E1:E3, checkbox5 mit F1:F3 .... bis checkbox12 mit
M1:M3
kann mann da den code einfacher schreiben?
vielen dank für eure hilfe
gruss Poseidon