Druckmakro läuft zu Lang
22.02.2006 11:21:57
walter
ich habe folgendes Druckmakro, welches ich von einer UF aus Aufrufe, es funktioniert aber es dauert sehr Lang, da bestimmte Spalten ausgeblendet werden und dann wieder eingeblendet werden müssen.
Wie kann man das Beschleunigen ?
Private Sub CommandButton3_Click()
'Sub VK_Druck_Hochformat()
Dim s
Dim z
Application.ScreenUpdating = False
Range("b:b,k:k,l:l,p:p,r:r,s:s,t:t,v:v,w:w,x:x,y:y,z:z,AA:AA,AB:AB").Select
Selection.ColumnWidth = 0# 'hiermit werden die Spalten ausgeblendet
z = Range("a3").End(xlDown).Row
ActiveSheet.Range(Cells(2, 1), Cells(z, 28)).Select
ActiveSheet.PageSetup.PrintArea = Range(Cells(2, 1), Cells(z, 28)).Address
With ActiveSheet.PageSetup
.PrintTitleRows = "$2:$3"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = Range(Cells(2, 1), Cells(z, 28)).Address
'ActiveSheet.PageSetup.PrintArea = "$A$3:$W$60"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "&""Arial,Fett""&12Geschäftswagen" & Chr(10) & "&14&A "
.RightHeader = "&""Arial,Fett"" "
.LeftFooter = "&""Arial,Fett""&8&P von &N"
.CenterFooter = " "
.RightFooter = "&""Arial,Fett""&8 &F &D &T"
.LeftMargin = Application.InchesToPoints(0.24)
.RightMargin = Application.InchesToPoints(0.24)
.TopMargin = Application.InchesToPoints(0.6)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0.2)
.FooterMargin = Application.InchesToPoints(0.2)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
' .PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 70
End With
''''ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Columns("a:a").ColumnWidth = 2.5
Columns("b:b").ColumnWidth = 7
Columns("c:c").ColumnWidth = 13
Columns("d:d").ColumnWidth = 3.2
Columns("e:e").ColumnWidth = 4.4
Columns("f:f").ColumnWidth = 17
Columns("g:g").ColumnWidth = 11.5
Columns("h:h").ColumnWidth = 9
Columns("i:i").ColumnWidth = 20
Columns("j:j").ColumnWidth = 10
Columns("k:k").ColumnWidth = 8
Columns("l:l").ColumnWidth = 6
Columns("m:m").ColumnWidth = 6
Columns("n:n").ColumnWidth = 7
Columns("o:o").ColumnWidth = 10
Columns("p:p").ColumnWidth = 5
Columns("q:q").ColumnWidth = 7
Columns("r:r").ColumnWidth = 0.5
Columns("s:s").ColumnWidth = 0.5
Columns("t:t").ColumnWidth = 0.5
Columns("u:u").ColumnWidth = 10
Columns("v:v").ColumnWidth = 5
Columns("w:w").ColumnWidth = 5
Columns("x:x").ColumnWidth = 5
Columns("y:y").ColumnWidth = 7
Columns("z:z").ColumnWidth = 9
Columns("AA:AA").ColumnWidth = 12
Columns("AB:AB").ColumnWidth = 10
Columns("c:c").ColumnWidth = 13 'muß hier nochmal stehen, sonst zu Breit
ActiveWindow.ScrollRow = 3 '3 Zeile
ActiveWindow.ScrollColumn = 1 '2 Spalte
Range("B3").Select
OptionButton6 = True
Range("B3").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios _
:=True, Password:="bwwb" 'schützen
Application.ScreenUpdating = True
End Sub
Gruß Walter