Re: Verlangsamte Ausführung
22.02.2003 22:41:25
Dirk
Hast ja Recht, dachte es gäbe vielleicht eine einfache Antwort...Sorry! Hier der Code:Sub Drucken()
Dim tb As Worksheet
Dim DL As DialogSheet
Dim CB As CheckBox
Dim inttmp As Integer
Set tb = ActiveSheet
Set DL = DialogSheets(1)
If tb Is Sheets("Datenbankeintragung") Then
MsgBox "Dieses Blatt zu drucken, ergibt keinen Sinn", vbOKOnly, "Achtung!"
Exit Sub
End If
If tb Is Sheets("Statistik") Then
tb.PageSetup.PrintArea = Range("a1:g14").Address
tb.PageSetup.CenterHeader = "Statistische Auswertung Bethesda Landau"
tb.PrintPreview
Exit Sub
End If
If tb Is Sheets("Statistik AH") Then
tb.PageSetup.PrintArea = Range("a1:c16").Address
tb.PageSetup.CenterHeader = "Statistische Auswertung Bethesda Landau"
tb.PrintPreview
Exit Sub
End If
If tb Is Sheets("Statistik AH") Then
tb.PageSetup.PrintArea = Range("a1:c16").Address
tb.PageSetup.CenterHeader = "Statistische Auswertung Bethesda Landau"
tb.PrintPreview
Exit Sub
End If
Application.ScreenUpdating = False
tb.Columns.Hidden = False
If Not DL.Show Then Exit Sub
For Each CB In DL.CheckBoxes
If CB = xlOff Then
tb.Columns(CB.Name).Hidden = True
End If
Next CB
If tb.Columns(9).Hidden = False Then
UserForm4.Show
End If
inttmp = Cells(Rows.Count, 1).End(xlUp).Row
With tb
.PageSetup.CenterHeader = "Anzahl der Beschäftigten: " & inttmp - 1
.PageSetup.PrintTitleRows = "$1:$1"
.PageSetup.PrintArea = Range("a1:P" & inttmp).Address
.PrintPreview
.Rows.Hidden = False
.Columns.Hidden = False
End With
Application.ScreenUpdating = True
End Sub
In Userform4 steht folgender Code:
Dim tb As Worksheet
Set tb = ActiveSheet
If CheckBox8.Value = True Then
Unload Me
Exit Sub
End If
X = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To X
If CheckBox1.Value = False Then GoTo 2
If Not UCase(Cells(i, 9)) = "BHH" Then
tb.Rows(i).EntireRow.Hidden = True
End If
2:
If CheckBox2.Value = False Then GoTo 3
If Not UCase(Cells(i, 9)) = "AH" Then
tb.Rows(i).EntireRow.Hidden = True
End If
3:
If CheckBox3.Value = False Then GoTo 4
If Not UCase(Cells(i, 9)) = "HW" Then
tb.Rows(i).EntireRow.Hidden = True
End If
4:
If CheckBox4.Value = False Then GoTo 5
If Not UCase(Cells(i, 9)) = "VW" Then
tb.Rows(i).EntireRow.Hidden = True
End If
5:
If CheckBox5.Value = False Then GoTo 6
If Not UCase(Cells(i, 9)) = "TZ" Then
tb.Rows(i).EntireRow.Hidden = True
End If
6:
If CheckBox6.Value = False Then GoTo 7
If Not UCase(Cells(i, 9)) = "KÜ" Then
tb.Rows(i).EntireRow.Hidden = True
End If
7:
If CheckBox7.Value = False Then GoTo 8
If Not UCase(Cells(i, 9)) = "HHW" Then
tb.Rows(i).EntireRow.Hidden = True
End If
8:
Next i
tb.Columns(9).Hidden = True
Unload Me
End Sub
Gruss Dirk