Office: Autofilter, Kopieren, Kriterium per VBA?

Moin, Jens,

zumindest das Einfügen des Datums kann ohne VBA über das Menü BEARBEITEN / KOPF- UND FUSSZEILE / BENUTZERDEFINIERTE KOPFZEILE udn die Verwendung des Kalendersymbols eingefügt werden. Sollte die Berechnung des Datums über VBA erfolgen, so ist festzulegen, in welchen der dreigeteilten Header dies einzufügen ist und dann etwas in der Art wie

Code:

im Workbook_BeforePrint-Ereignis anzulegen.

Zum Ausdruck mit Gitterlinien: nur das, was Excel als zu druckenden Bereich anhand von Werten identifiziert, wird auch mit Gitternetzlinien versehen. In diesem Fall sollte per VBA der Druckbereich um z.B. zwei Spalten vergrößert werden, eine Möglichkeit dazu wäre (hier ist auf die ausgeblendeten Spalten weiter anzugehen, da im Code nur der Bereich um 2 Spalten, sichtbar oder nicht, erweitert wird):

Code:

 

moin jinx,

das mit dem datum klappt problemlos, mit den gitternetzlinien leider ...
in der vorschau sieht man, das nur in der letzten leeren spalte die zeilen unterstrichen werden ...die restlichen zellen bleiben ohne gitternetz ...

hier mein code ...

Sub Listen()
With Sheets("Liste")
With .Range("A1:AB1")
If Sheets("Liste").AutoFilterMode Then .AutoFilter
.AutoFilter
If Sheets("Edit").Range("A2").Value "" Then
If Sheets("Edit").Range("B2").Value "" Then
.AutoFilter Field:=1, Criteria1:=Sheets("Edit").Range("A2").Value, Operator:=xlOr, _
Criteria2:=Sheets("Edit").Range("B2").Value
Else
.AutoFilter Field:=1, Criteria1:=Sheets("Edit").Range("A2").Value
End If
End If
If Sheets("Edit").Range("C2").Value "" Then
.AutoFilter Field:=3, Criteria1:=Sheets("Edit").Range("C2")
End If
If Sheets("Edit").Range("D2").Value "" Then
.AutoFilter Field:=14, Criteria1:=Sheets("Edit").Range("D2")
End If
If Sheets("Edit").Range("E2").Value "" Then
.AutoFilter Field:=6, Criteria1:=Sheets("Edit").Range("E2")
End If
End With
.Range("A1").CurrentRegion.SpecialCells(xlVisible).Copy
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Gefilterte Daten_" & Right("000" & Worksheets.Count, 3)
Range("A1").Select ' IMHO redundant, da auf einer neuangelegten Tabelle immer A1 aktiv ist
ActiveCell.PasteSpecial Paste:=xlPasteAll
End With
Application.CutCopyMode = False
Columns("A:AB").Columns.AutoFit
Range("G:K,O:AB").EntireColumn.Hidden = True
ActiveSheet.PageSetup.Orientation = xlLandscape
ActiveSheet.PageSetup.CenterHeader = "&D"
Dim rngBereich As Range
Set rngBereich = Range("A:F,L:N").CurrentRegion
Set rngBereich = rngBereich.Resize(rngBereich.Rows.Count, rngBereich.Columns.Count + 2)
With ActiveSheet.PageSetup
.PrintArea = rngBereich.Address
.PrintGridlines = True
End With
Set rngBereich = Nothing
If Sheets("Liste").AutoFilterMode Then Sheets("Liste").Range("A1:AA1").AutoFilter
End Sub


danke und gruß jens *Smilie

 

Moin, jens,

Du kannst für die Eigenschaft der Zuweisung CurrentRegion nach meinem Wissen nur einen Bereich (und keinen zweigeteilten) angeben. Bei Deiner mir vorliegenden Beispielmappe könntest Du die Zuweisung des Druckbereiches z.B. per

Code:

realisieren - dort werden dann zwei zusätzliche Spalten mit Gitternetzlkinien angezeigt.

 

moin jinx,

leider besteht das problem weiterhin, es werden nur die letzten beiden spalten mit gitternetzlinien angezeigt, der rest hat kein

zur info der bereich um fasst die spalten A:AD, wobei natürlich einige spalten ausgeblendet werden ....

hier nochmal der code mit deiner ersten formel, wie gesagt, bei der zweiten kam das gleiche ergebnis ...

Sub Listen()
With Sheets("Liste")
With .Range("A1:AB1")
If Sheets("Liste").AutoFilterMode Then .AutoFilter
.AutoFilter
If Sheets("Edit").Range("A2").Value "" Then
If Sheets("Edit").Range("B2").Value "" Then
.AutoFilter Field:=1, Criteria1:=Sheets("Edit").Range("A2").Value, Operator:=xlOr, _
Criteria2:=Sheets("Edit").Range("B2").Value
Else
.AutoFilter Field:=1, Criteria1:=Sheets("Edit").Range("A2").Value
End If
End If
If Sheets("Edit").Range("C2").Value "" Then
.AutoFilter Field:=3, Criteria1:=Sheets("Edit").Range("C2")
End If
If Sheets("Edit").Range("D2").Value "" Then
.AutoFilter Field:=14, Criteria1:=Sheets("Edit").Range("D2")
End If
If Sheets("Edit").Range("E2").Value "" Then
.AutoFilter Field:=6, Criteria1:=Sheets("Edit").Range("E2")
End If
End With
.Range("A1").CurrentRegion.SpecialCells(xlVisible).Copy
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Gefilterte Daten_" & Right("000" & Worksheets.Count, 3)
Range("A1").Select ' IMHO redundant, da auf einer neuangelegten Tabelle immer A1 aktiv ist
ActiveCell.PasteSpecial Paste:=xlPasteAll
End With
Application.CutCopyMode = False
Columns("A:AB").Columns.AutoFit
Range("G:K,O:AB").EntireColumn.Hidden = True
ActiveSheet.PageSetup.Orientation = xlLandscape
ActiveSheet.PageSetup.RightHeader = "&D"
Dim rngBereich As Range
Set rngBereich = Range("A1").CurrentRegion
Set rngBereich = rngBereich.Resize(rngBereich.Rows.Count, rngBereich.Columns.Count + 2)
With ActiveSheet.PageSetup
.PrintArea = rngBereich.Address
.PrintGridlines = True
End With
Set rngBereich = Nothing
If Sheets("Liste").AutoFilterMode Then Sheets("Liste").Range("A1:AA1").AutoFilter
End Sub

gruß jens *Smilie

 

Moin, Jens,

mal eine Frage: meinst Du wirklich, dass es nötig ist, den gesamten Code unformatiert wiederholt in die Beiträge einzustellen? Ich denke da an die Forums-DB, bei der ich für jeden Buchstaben dankbar bin, der nicht einfließt.

Leider bin ich nur in der Lage, Probleme zu lösen, die ich nachstellen kann - aus Deiner Beispielmappe mit dem von mir vorgegebenen Code erstellt Excel2000 SP-3 folgende Seitenvorschau (hier nur als Ausschnitt):





Was daran dann von der Norm abweichen soll, kann ich nicht nachvollziehen.

 

moin jinx,

das funzt bei mir auch mit der modifizierten mappe...

im übrigen ist bei dem jetzigen code unter seite einreichten, tabellen das häckchen bei "gitternetzlinien drucken" gesetzt, wenn ich aber auf seitenvorschau gehe sind keine gitternetzlinien zu sehen bzw. nur bei den beiden leeren spalten und wenn ich die seite drucke wird auch kein gitternetz gedruckt ....

ich fummle mal noch ein bischen rum

gruß jens

 

moin jinx,

ich habs, le lag daran das die zellen der datenliste als farbe weiß hatten ...

gruß und schönen dank

jens *Smilie