Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
24.04.2024 18:49:56
24.04.2024 17:19:09
Anzeige
Archiv - Navigation
860to864
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
860to864
860to864
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

An fcs: doch noch ein Problem!

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


2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: An fcs: doch noch ein Problem!
14.04.2007 17:42:38
fcs
Hallo Andreas,
hier die ersten Zeilen deines Druckcodes mit der entsprechendne Ergänzung der Prüfung


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
'prüfen, ob Autofilter aktiv und ggf. deaktivieren
If .AutoFilterMode = True Then .AutoFilterMode = False
'Filter setzen
.Range("AD7:AD65536").Autofilter Field:=1, Criteria1:="<>", Operator:=xlAnd
Application.Calculation = xlCalculationAutomatic


Gruß
Franz

Anzeige
Danke, jetzt habe ich es!
14.04.2007 17:57:34
Andreas
Vielen, vielen Dank für die Hilfe! Jetzt geht alles super!
mfg, Andreas

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige