Option
Explicit
Sub
Drucke()
On
Error
GoTo
fail
With
Sheets(
"Kalt"
)
Application.ScreenUpdating =
False
.Visible = -1
Call
Filtern(.Name)
.PrintOut
.AutoFilterMode =
False
.Visible = 2
End
With
fail:
Application.ScreenUpdating =
True
End
Sub
Private
Sub
Filtern(
ByVal
tbName
As
String
)
Dim
Rng
As
Range, lngCol
As
Long
Dim
strCriteria
As
String
, vField
As
Variant
strCriteria = USDatumErstellen(
Date
)
vField = 3
With
Sheets(tbName)
Set
Rng = .UsedRange
lngCol = Rng.Columns(1).Column
If
lngCol <> 1
Then
Set
Rng = Rng.Offset(, 1 - lngCol).Resize(, lngCol - 1 + Rng.Columns.Count)
vField = 2
End
If
Rng.AutoFilter
.Range(Rng.Address).AutoFilter Field:=vField, Operator:= _
xlFilterValues, Criteria2:=Array(2, strCriteria)
End
With
End
Sub
Private
Function
USDatumErstellen(x
As
Variant
)
If
Not
IsDate(x)
Then
Exit
Function
USDatumErstellen =
""
& Month(x) &
"/"
& Day(x) &
"/"
& Year(x) &
""
End
Function