An fcs: doch noch ein Problem!
14.04.2007 17:03:57
Andreas
Hallo Franz!
Ich habe doch noch ein Problem:
Nachfolgend 2 Codes:
1. Setzen eines Autofilters der bestehen bleibt, bis er beendet wird (durch einen anderen Code).
2. Setzen eines Autofilters und Ausdruck.
Da beim 1. Code der Filter ja nicht zurückgesetzt wird müsste beim 2. Code auch eine Prüfung beinhaltet sein, ob ein Filter aktiv ist.
Kannst du mir noch mal helfen?
mfg, Andreas
Private Sub CommandButton_BesucherTag1_Click()
Dim wks As Worksheet, Bereich As Range
'zur Auswertung wechseln
Sheets("Auswertung").Select
Sheets("Auswertung").Unprotect "xyz"
Application.ScreenUpdating = False
Set wks = Worksheets("Auswertung")
Set Bereich = wks.Range("AC7:AF65536")
'prüfen, ob Autofilter aktiv und ggf. deaktivieren
If wks.AutoFilterMode = True Then wks.AutoFilterMode = False
'Filter für Bereich setzen
With Bereich
.AutoFilter Field:=1, Criteria1:="=1" 'Filter 1. Spalte von Bereich
End With
Sheets("Auswertung").Protect "xyz"
Application.ScreenUpdating = True
Sheets("Auswertung").Range("B1").Select
End Sub
Private Sub CommandButtonDruck2_Click()
Dim lZeile As Long
'zur Auswertung wechseln
Sheets("Auswertung").Select
With Sheets("Auswertung")
.Unprotect "xyz"
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'per Autofilter Zeilen ausblenden
.Range("AD7:AD65536").AutoFilter Field:=1, Criteria1:="<>", Operator:=xlAnd
Application.Calculation = xlCalculationAutomatic
'Sortieren nach Firma
.Range("A8:AF1500").Sort Key1:=Range("B8"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'Spalten ausblenden
.Range("A:A,C:C,E:E,F:F,G:G,H:H,I:I,L:AG").EntireColumn.Hidden = True
With .PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
.PageSetup.PrintArea = ""
With .PageSetup
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.78740157480315)
.TopMargin = Application.InchesToPoints(0.78740157480315)
.BottomMargin = Application.InchesToPoints(0.590551181102362)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = True
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 999
End With
Application.ScreenUpdating = True
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Selection.AutoFilter 'Autofilter wieder abschalten
.Columns.EntireColumn.Hidden = False
'nach Nummern sortieren
.Range("A8:AF1500").Sort Key1:=Range("A8"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
.Protect "xyz"
.Range("B1").Select
End With
End Sub