Hallo hajo, hallo Rainer, hallo alle anderen,
vielen Dank schonmal für die Ideen. Und sorry, dass ich mich erst jetzt melde.
@Rainer: Die Idee ist nicht schlecht, doch müssen der Rot- und Blau-Bereich auf einer Liste stehen.
M.E. geht das, wie hajo gemeint hat, nur über VBA. Und das kann ich gar nicht.
Aber ich habe mir noch ein paar Gedanken gemacht und überlegt, ass ich in dem Blaubereich eine Abfrage je Spalte und Liegenschaft mache:
Beispiel für Liegenschaft 1 Spalte M:
=WENN(ANZAHL2(M3:M18)=0;WAHR;"X")
Dann kann ich über 'gehe zu' alle Wahrheitswerte markieren und diese Spalten ausbelnden.
Dann markiere ich den Bereich der ersten Liegenschaft, wähle unter Druckoptionen den markierten Bereich und die Größe etc. aus und drucke.
Neue Beispieldatei:
www.file-upload.net/download-6645456/Beispiel2.xls.html
ABER das entstandene Makro bleibt bei einer Zeile immer hängen:
Selection.PrintOut Copies:=1, Collate:=True,IgnorePrintAreas:=False
Und ich weiß nicht wieso. GRRRRR
Ich habe das Makro über aufzeichen erstellt. Wird wohl dementsprechend aussehen. (Für den geübten Blick.)
Wenn also irgendjemand eine Idee hat, wäre ich sehr dankbar und bedanke mich schonmal im Voraus dafür.
Sub Druck()
'
Range("M1:AN1").Select
Range("AN1").Activate
Selection.SpecialCells(xlCellTypeFormulas, 4).Select
Selection.EntireColumn.Hidden = True
Range("A1:AT19").Select
Range("AT19").Activate
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = "$A$1:$AT$31"
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintSheetEnd
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA3
.FirstPageNumber = xlAutomatic
.Order = xlOverThenDown
.BlackAndWhite = False
.Zoom = 52
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = False
.AlignMarginsHeaderFooter = True
End With
Application.PrintCommunication = True
Selection.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
ActiveWindow.LargeScroll ToRight:=1
Columns("V:AO").Select
Range("AO1").Activate
Selection.EntireColumn.Hidden = False
Range("AN20").Select
Range(Selection, Selection.End(xlToLeft)).Select
Selection.SpecialCells(xlCellTypeFormulas, 4).Select
Selection.EntireColumn.Hidden = True
Range("A20:AT31").Select
Range("AT31").Activate
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = "$A$1:$AT$31"
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintSheetEnd
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA3
.FirstPageNumber = xlAutomatic
.Order = xlOverThenDown
.BlackAndWhite = False
.Zoom = 52
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = False
.AlignMarginsHeaderFooter = True
End With
Application.PrintCommunication = True
Selection.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
ActiveWindow.LargeScroll ToRight:=1
Columns("AD:AO").Select
Range("AO1").Activate
Selection.EntireColumn.Hidden = False
End Sub
Gruß Maik