Fehlerhaftes Verhalten von Excel beim Druck

[PromiseYou]

Hallo zusammen

Ich verzweifele Gerade, und hoffe, dass mir hier jemand eine Hilfe geben kann.

Beschreibung der Situation:

Aus einer Datenbank werden Daten ausgelesen, und auf diverse Tabellenblätter einer neuen Mappe aufgeteilt.

Die neuen Blätter werden aus einer Vorlage erstellt, wo bereits eine Seitenformatierung stattgefunden hat.

Diese Seiten werden auch anstandsfrei in die neue Arbeitsmappe aufgenommen, und auch gespeichert.

Öffnet man nun diese Datei, und geht Arbeitsblatt für Arbeitsblatt durch, sind in den Seiteneinstellungen auch die Werte drin, die in der Vorlage vorgegeben waren (als Beispiel halt DIN A4 Landscape mit Fit auf eine Seitenbreite und Ränder auf 1,5 cm reduziert)

Problem:

Wenn ich nun mehrere Tabellenblätter dieser Mappe aktiviere, und dann über "Drucken" - "Auswahl" diese Blätter ausdrucken möchte, wird nur das erste Blatt formatiert, die nachfolgenden Blätter werden dann entsprechend der "WindowsVoreinstellung" (DinA4 normal, ohne Fit und Ränder mit 2 - 2,5 cm)

Auch der Eintrag in der

Private Sub Workbook_BeforePrint(Cancel As Boolean)

  If Not ActiveSheet.PageSetup.PrintTitleRows = "$1:$8" Then ActiveSheet.PageSetup.PrintTitleRows = "$1:$8"

  If Not ActiveSheet.PageSetup.PrintTitleColumns = "" Then ActiveSheet.PageSetup.PrintTitleColumns = ""

  If Not ActiveSheet.PageSetup.PrintArea = "" Then ActiveSheet.PageSetup.PrintArea = ""

  If Not ActiveSheet.PageSetup.LeftHeader = "" Then ActiveSheet.PageSetup.LeftHeader = ""

  If Not ActiveSheet.PageSetup.CenterHeader = "" Then ActiveSheet.PageSetup.CenterHeader = ""

  If Not ActiveSheet.PageSetup.RightHeader = "" Then ActiveSheet.PageSetup.RightHeader = ""

  If Not ActiveSheet.PageSetup.LeftFooter = "" Then ActiveSheet.PageSetup.LeftFooter = ""

  If Not ActiveSheet.PageSetup.CenterFooter = "" Then ActiveSheet.PageSetup.CenterFooter = ""

  If Not ActiveSheet.PageSetup.RightFooter = "" Then ActiveSheet.PageSetup.RightFooter = ""

  If Not ActiveSheet.PageSetup.LeftMargin = Application.InchesToPoints(0.590551181102362) Then ActiveSheet.PageSetup.LeftMargin = Application.InchesToPoints(0.590551181102362)

  If Not ActiveSheet.PageSetup.RightMargin = Application.InchesToPoints(0.590551181102362) Then ActiveSheet.PageSetup.RightMargin = Application.InchesToPoints(0.590551181102362)

  If Not ActiveSheet.PageSetup.TopMargin = Application.InchesToPoints(0.590551181102362) Then ActiveSheet.PageSetup.TopMargin = Application.InchesToPoints(0.590551181102362)

  If Not ActiveSheet.PageSetup.BottomMargin = Application.InchesToPoints(0.590551181102362) Then ActiveSheet.PageSetup.BottomMargin = Application.InchesToPoints(0.590551181102362)

  If Not ActiveSheet.PageSetup.HeaderMargin = Application.InchesToPoints(0.511811023622047) Then ActiveSheet.PageSetup.HeaderMargin = Application.InchesToPoints(0.511811023622047)

  If Not ActiveSheet.PageSetup.FooterMargin = Application.InchesToPoints(0.511811023622047) Then ActiveSheet.PageSetup.FooterMargin = Application.InchesToPoints(0.511811023622047)

  If Not ActiveSheet.PageSetup.PrintHeadings = False Then ActiveSheet.PageSetup.PrintHeadings = False

  If Not ActiveSheet.PageSetup.PrintGridlines = False Then ActiveSheet.PageSetup.PrintGridlines = False

  If Not ActiveSheet.PageSetup.PrintComments = xlPrintNoComments Then ActiveSheet.PageSetup.PrintComments = xlPrintNoComments

  If Not ActiveSheet.PageSetup.PrintQuality(1) = 600 Then ActiveSheet.PageSetup.PrintQuality(1) = 600

  If Not ActiveSheet.PageSetup.PrintQuality(2) = 600 Then ActiveSheet.PageSetup.PrintQuality(2) = 600

  If Not ActiveSheet.PageSetup.CenterHorizontally = False Then ActiveSheet.PageSetup.CenterHorizontally = False

  If Not ActiveSheet.PageSetup.CenterVertically = False Then ActiveSheet.PageSetup.CenterVertically = False

  If Not ActiveSheet.PageSetup.Orientation = xlLandscape Then ActiveSheet.PageSetup.Orientation = xlLandscape

  If Not ActiveSheet.PageSetup.Draft = False Then ActiveSheet.PageSetup.Draft = False

  If Not ActiveSheet.PageSetup.PaperSize = xlPaperA4 Then ActiveSheet.PageSetup.PaperSize = xlPaperA4

  If Not ActiveSheet.PageSetup.FirstPageNumber = xlAutomatic Then ActiveSheet.PageSetup.FirstPageNumber = xlAutomatic

  If Not ActiveSheet.PageSetup.Order = xlDownThenOver Then ActiveSheet.PageSetup.Order = xlDownThenOver

  If Not ActiveSheet.PageSetup.BlackAndWhite = False Then ActiveSheet.PageSetup.BlackAndWhite = False

  If Not ActiveSheet.PageSetup.Zoom = False Then ActiveSheet.PageSetup.Zoom = False

  If Not ActiveSheet.PageSetup.FitToPagesWide = 1 Then ActiveSheet.PageSetup.FitToPagesWide = 1

  If Not ActiveSheet.PageSetup.FitToPagesTall = False Then ActiveSheet.PageSetup.FitToPagesTall = False

End Sub

bringt nicht den gewünschten Erfolg.

Wie kann ich erreichen, dass wirklich JEDE Seite formatiert wird ?

Mein erster Versuch war, jedes einzelene Blatt mit diesen Parametern zu "befüllen", was jedoch zu lange dauert (ist ja auch überall zu lesen). Trotz der enormen "Mehrzeit" ist der Erfolg ausgeblieben, so dass ich dann umgestellt habe auf eine vorformatierte Vorlage und dann nur noch die Angaben überprüfe.

Die evt. Mechanismen müssen abwärtskompatibel sein bis EXCEL 2000 :floet: