Anzeige
Archiv - Navigation
736to740
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
736to740
736to740
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Druckmakro läuft zu Lang

Druckmakro läuft zu Lang
22.02.2006 11:21:57
walter
Guten Tag,
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

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Druckmakro läuft zu Lang
22.02.2006 14:41:05
Martin
Hallo Walter
bei mir läuft dein Makro (bei einem mehr oder weniger leeren Sheet) in weniger als 3 Sekunden durch. Das scheint mir nun nicht gerade langsam.. :-)
Ein paar generelle Tips:
Statt am Anfang die Kolonnenbreiten auf Null zu setzen, würde ich sie richtig ausblenden (Selection.EntireColumn.Hidden = True), evtl sparst du dir dadurch am Schluss das erneute Einstellen der Spaltenbreiten; du kannst die Kolonnen einfach mit Hidden=False wieder einblenden.
Die "With ActiveSheet.PageSetup"-Schleife kannst du deutlich grösser setzen, da du dieses Objekt auch weiter unten noch ansprichst.
Sollte es in deinem Blatt viele Formeln haben, die Excel evtl neu zu berechnen versucht, so kannst du das abstellen mit Application.Calculation = xlCalculationManual, und am Schluss wieder einschalten mit Application.Calculation = xlCalculationAutomatic.
Ich hoffe, das hilft dir etwas.
Gruss
Martin
Anzeige
Bitte noch...
22.02.2006 16:26:08
walter
Hallo Martin,
habe schon mal Kalkulation so abgestellt:
With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
und natürlich wieder eingesetllt, brauch immer noch ca. 15 sekunden !!!
Wie meinst Du das mit With ac...Page. grösser setzen etc. und mit dem ausblenden?
Könntest Du mir mein Makro mal so wie Du meinst abändern, Bitte Bitte,
denke bitte daran ich brauch die Spaltenbreiten nachher wieder...
Danke im voraus
Gruß Walter
AW: Bitte noch...
22.02.2006 16:40:35
Martin
Hallo Walter
vielleicht müsstest du mal deine Beispieltabelle hochladen.
Ich habe mal die erwähnten Punkte in dein Makro eingebaut, bei mir hat es allerdings nicht viel gebracht, da es ja ohnehin schon sehr schnell war... :

Private Sub DruckTest()
'Sub VK_Druck_Hochformat()
Dim s
Dim z
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'hiermit werden die Spalten ausgeblendet:
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").EntireColumn.Hidden = True
z = Range("a3").End(xlDown).Row
ActiveSheet.Range(Cells(2, 1), Cells(z, 28)).Select
With ActiveSheet.PageSetup
.PrintArea = Range(Cells(2, 1), Cells(z, 28)).Address
.PrintTitleRows = "$2:$3"
.PrintTitleColumns = ""
.PrintArea = Range(Cells(2, 1), Cells(z, 28)).Address
'.PrintArea = "$A$3:$W$60"
.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
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").EntireColumn.Hidden = False
Columns("a:a").ColumnWidth = 2.5
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("m:m").ColumnWidth = 6
Columns("n:n").ColumnWidth = 7
Columns("o:o").ColumnWidth = 10
Columns("q:q").ColumnWidth = 7
Columns("u:u").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.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Ich hoffe, es hilft.
Gruss
Martin
Anzeige
Hallo habe auch...
22.02.2006 16:50:54
walter
Hallo Martin,
ich weiß nicht was Du mit "With ActiveSheet.PageSetup"v Schleife grösser setzen meinst ?
Habe aber das Makro mal so abgeändert anstatt 15-17 !!! Sekunden bis zum Druckdialog-Menü dauert es nur 7 Sekunden sind allerdings nur 35 Zeilen, vielleicht habe ich jetzt schon ausgereizt ?
Hier das geänderte Makro:

Private Sub CommandButton3_Click()
Dim s
Dim z
'Application.ScreenUpdating = False
ActiveSheet.Unprotect ("bwwb")            'so hebt richtig auf
Application.Calculation = xlCalculationManual                <<<
' Range("H:H,J:J,O:O,P:P,Q:Q,S:S,T:T,U:U,V:V,W:W,J:J").Select
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
Selection.EntireColumn.Hidden = True       ' NEU eingesetzt von Martin 22.02.2006
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
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
Selection.EntireColumn.Hidden = False
ActiveWindow.ScrollRow = 3           '3 Zeile
ActiveWindow.ScrollColumn = 1        '2 Spalte
Range("B3").Select
Application.Calculation = xlCalculationManual
'   With Application
'       .Calculation = xlAutomatic              'Berechnung auf Automatisch
'       .MaxChange = 0.001
'   End With
OptionButton6 = True
Range("B3").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios _
:=True, Password:="bwwb"                                      'schützen
Application.ScreenUpdating = True
End Sub

Danke für deine bisherige Unterstützung,
mfg Walter
Anzeige
Danke o.t.
22.02.2006 23:33:56
Walter
Hallo Martin,
werde morgen in der Fa. testen da mein Rechner zu Hause auch "zu schnell" ist, gebe bescheid,
gruß Walter

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige