anbei mein Makro
04.02.2015 16:38:12
kurt
Hallo,
anbei mein Makro:
Public Sub Drucken()
Dim s
Dim z As Long
Dim Antwort
ActiveSheet.Unprotect (getStrPasswort)
ActiveSheet.Application.ScreenUpdating = False
ActiveSheet.Range("M3:S49").Select
With ActiveSheet.PageSetup
.PrintArea = Range(Cells(3, 13), Cells(47, 19)).Address
' ActiveSheet.Range("B2:K41").Address
' .PrintTitleRows = "$1:$3"
' .PrintTitleColumns = ""
''' .LeftFooter = ActiveSheet.Cells(17, 16).Value
' .LeftFooter = "&8&P von &N"
' .CenterFooter = "&8 "
' .LeftFooter = "&8&P von &N"
' .CenterFooter = ""
.RightFooter = ""
' .RightFooter = _
"&""Arial,Fett""&8Datei:&""Arial,Standard""&10 &F &""Arial,Fett"" &8Tab: &""Arial,Standard"" _
&10 &8&A &D / &T"
' .RightFooter = "&8 &F / &A &D &T"
' .LeftFooter = "&""Arial,Fett""&8&P von &N"
' .RightFooter = "&""Arial,Fett""&8 &F &D &T"
' .CenterHorizontally = True
' .CenterVertically = False
' .Orientation = xlLandscape ' für Querformat
' .Orientation = xlPortrait ' für Hochformat
' .Zoom = False ' wird angepaßt
'-- damit wird auf Anpassen gestellt -----
.FitToPagesWide = 1
.FitToPagesTall = False
End With
''' ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActiveWindow.ScrollRow = 1 '1 Zeile
ActiveWindow.ScrollColumn = 1 '1 Spalte
ActiveSheet.Range("D3").Select
ActiveSheet.Application.ScreenUpdating = True
End Sub
gruß
kurt k