AW: der Bereich der Fußzeile......
06.03.2014 18:53:38
fcs
Hallo Duinne,
hier ein entssprechendes Makro, das die Stückliste in eine neu Arbeitsmappe kopiert und aufbereitet für den Druck. Wenn das Druckblatt innerhalb der Datei mit der Stückliste angelegt werden soll, dann muss die Anpassungen entsprechend Kommentaren beachten. Ein paar Zeilen sind dann anzupassen.
Gruß
Franz
'Makro in einem allgemeinen Modul
Sub DruckAusgabe()
Dim wksListe As Worksheet, Zeile_S As Long, Zeile_SL As Long
Dim wksDruck As Worksheet, Zeile_D As Long, Zeile_S1 As Long
Dim rngFuss As Range, rngKopf As Range
Dim lngSeite As Long, AnzSeiten As Long
Dim AnzPosproSeite As Long, AnzZeilenproSeite As Long
Application.ScreenUpdating = False
Set wksListe = ActiveWorkbook.Worksheets("Stückliste")
GoTo Weiter01
'ggf. vorhandenes Blatt "Druck" löschen - nur erforderlich, wenn Blatt für
'Druckausgabe innerhalb der Datei mit der Stückliste erstellt werden soll
For Each wksDruck In ActiveWorkbook.Sheets
If wksDruck.Name = "Druck" Then
Application.DisplayAlerts = False
wksDruck.Delete
Application.DisplayAlerts = True
Exit For
End If
Next
Weiter01:
With wksListe
'letzte Zeile in Stückliste
Zeile_SL = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
With .UsedRange
' Zeile_SL = .Row + .rpws.Count - 1
End With
'Blatt "Stückliste" kopieren für Druckausgabe innerhalb der Datei
' .Copy after:=wksListe
'Blatt "Stückliste" in neue Datei kopieren für Druckausgabe
.Copy
Set wksDruck = ActiveSheet
End With
With wksDruck
' .Name = "Druck" 'nur erforderlich bei Druckausgabe innerhalb Datei
'Startwerte setzen
Set rngKopf = .Range("11:13") 'Titelzeilen auf jeder Seite
Set rngFuss = .Range("1:10") 'Fusszeilen auf jeder Seite
AnzPosproSeite = 8 'Anzahl Positionen pro Seite
AnzZeilenproSeite = 2 * AnzPosproSeite 'Anzahl Tabellenzeilen mit Positionen pro Seite
lngSeite = 0 'Startwert Seitenzähler
Zeile_S1 = 14 'Zeile mit 1. Position in Stückliste
Zeile_D = Zeile_S1 'Startwert Zeilenzähler in Druckausgabe setzen
For Zeile_S = Zeile_S1 To Zeile_SL Step AnzZeilenproSeite
lngSeite = lngSeite + 1
If lngSeite > 1 Then
'Kopfzeilenblock einfügen
rngKopf.Copy
.Cells(Zeile_D, 1).Insert
Zeile_D = Zeile_D + rngKopf.Rows.Count
End If
'Fusszeilenblock einfügen
Zeile_D = Zeile_D + AnzZeilenproSeite
rngFuss.Copy
.Cells(Zeile_D, 1).Insert
'Nummer der Seite eintragen in Fusszeile
.Cells(Zeile_D + rngFuss.Rows.Count - 2, 19).Value = Format(lngSeite, "000")
AnzSeiten = lngSeite
If Zeile_S + AnzZeilenproSeite > Zeile_SL + 1 Then
'ggf. Leerzeilen am Listenende formatieren
'Letzte Leerposition auf Seite
With wksListe
.Range(.Rows(Zeile_SL - 1), .Rows(Zeile_SL)).Copy
End With
.Range(.Rows(Zeile_D - 2), .Rows(Zeile_D - 1)) _
.PasteSpecial Paste:=xlPasteFormats
'Letzte 1. bis vorletzte Position auf Seite
With wksListe
.Range(.Rows(Zeile_SL - 3), .Rows(Zeile_SL - 2)).Copy
End With
.Range(.Rows(Zeile_D - AnzZeilenproSeite), .Rows(Zeile_D - 3)) _
.PasteSpecial Paste:=xlPasteFormats
End If
Zeile_D = Zeile_D + rngFuss.Rows.Count
Next Zeile_S
Application.CutCopyMode = False
'Gesamtblattanzahl auf allen Seiten eintragen
'Zeile mit gesamtseiten auf Blatt 1
Zeile_S = Zeile_S1 + AnzZeilenproSeite + rngFuss.Rows.Count - 1
For lngSeite = 1 To AnzSeiten
.Cells(Zeile_S, 19).Value = Format(AnzSeiten, "000") & " Bl."
Zeile_S = Zeile_S + (rngKopf.Rows.Count + AnzZeilenproSeite _
+ rngFuss.Rows.Count) * lngSeite
Next
'letzte Zeile für Druckbereich ermitteln
Zeile_D = Zeile_D - 1 - rngFuss.Rows.Count
'Zellbereich mit Fusszeilen in Zeilen 1 bis 10 löschen
rngFuss.Delete shift:=xlShiftUp
'Seite einrichten
With .PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
.PrintArea = "$A$1:$S$" & Zeile_D
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.CentimetersToPoints(0.7)
.RightMargin = Application.CentimetersToPoints(0.5)
.TopMargin = Application.CentimetersToPoints(1.3)
.BottomMargin = Application.CentimetersToPoints(1.7)
.HeaderMargin = Application.CentimetersToPoints(1.3)
.FooterMargin = Application.CentimetersToPoints(0.8)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments 'ggf. = 0
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = False
End With
End With
Application.ScreenUpdating = True
End Sub