Live-Forum - Die aktuellen Beiträge
Datum
Titel
16.04.2024 12:41:11
Vielleicht Onur ? Leider werden nicht alle Monate
16.04.2024 12:08:33
Zelle/Spalte bestimmten Wert in Kopfzeile zuordnen
16.04.2024 12:01:17
Dynamische Liste generiert aus mehreren Vorgagen
16.04.2024 11:48:22
Blatt in HTML exportieren wenn Checkbox aktiv ist
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
908to912
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
908to912
908to912
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Mehrere Tballenblätter dynamisch drucken

Mehrere Tballenblätter dynamisch drucken
01.10.2007 08:25:18
Roland
Hallo Excel- VBAprofis
Bei folgendem Problem komme ich nicht weiter.
Ich kopiere mit untenstehendem Code eine gefilterte Ansicht über 12 Tabellenblätter auf ein Temporäres Tabellenblatt und Drucke dann diese "Zusammenfassung" aus.
Das ganze funktioniert auch alles einwandfrei.
Da aber die Anzahl der gefilterten Mitarbeiter unterschiedlich sein kann, möchte ich auf dem Temporären Tabellenblatt die "Aneinanderreihung" der einzelnen "Bilder" dynamisch halten. Das heisst bei zB. Paste Destination:=.Range("A22") möchte ich den Range nicht fix auf ("A22") setzen sondern dynamisch an das erste "Bild" anhängen.
Könnt ihr mir weiterhelfen?
Besten Dank
Gruss
Roland

Sub DruckenJahresuebersicht()
Dim Bereich As Range
Dim i As Integer
Set Bereich = Range("A1:BO" & Cells(Rows.Count, 3).End(xlUp).Row)
'Anzahl gefilterte Mitarbeiter zählen
ActiveSheet.Unprotect myPwd
i = Intersect(Bereich.SpecialCells(xlVisible), _
Bereich.Columns(1)).Count - 1
ActiveSheet.Protect myPwd
'Anzahl Mitarbeiter überprüfen
If i > 18 Then
MsgBox "Es sind zuviele Mitarbeiter Ausgewählt! Bitte Filter setzen!", vbInformation, " _
Druckmenü"
Exit Sub
End If
' Temporäres Tabellenblatt erstellen
Application.ScreenUpdating = False
Worksheets.Add Before:=Worksheets(1)
On Error Resume Next
With Worksheets(1)
'Januar Kopieren
Worksheets("Januar").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A1")
'Februar Kopieren
Worksheets("Februar").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A22")
'März Kopieren
Worksheets("März").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A43")
'April Kopieren
Worksheets("April").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A64")
'Mai Kopieren
Worksheets("Mai").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A85")
'Juni Kopieren
Worksheets("Juni").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A106")
'Juli Kopieren
Worksheets("Juli").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A127")
'August Kopieren
Worksheets("August").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A148")
'September Kopieren
Worksheets("September").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A169")
'Oktober Kopieren
Worksheets("Oktober").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A190")
'November Kopieren
Worksheets("November").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A211")
'Dezember Kopieren
Worksheets("Dezember").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A232")
On Error GoTo 0
'Ausdrucken
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.31496062992126)
.RightMargin = Application.InchesToPoints(0.31496062992126)
.TopMargin = Application.InchesToPoints(0.78740157480315)
.BottomMargin = Application.InchesToPoints(0.78740157480315)
.Orientation = xlPortrait
.Zoom = 70
End With
'.PrintOut
Application.Dialogs(xlDialogPrint).Show
'Temporäres Tabellenblatt wieder löschen
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
Menüleiste.AktuellerMonat
Application.ScreenUpdating = True
End Sub


6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Mehrere Tballenblätter dynamisch drucken
01.10.2007 10:52:54
fcs
Hallo Roland,
ich hab dein Makro angepasst und die Monate Januar bis März umgestellt, die restlichen Monate sind in gleicher Weise anzupassen.
Evtl. klappt ja auch die Kurzfassung mit Kopieren der Monate in einer Schleife; dazu müssen die Monatsblätter die Namen so haben wie das Zeitformat den Monats-Langnamen schreibt oder du verwendest ggf. nur die Blattnummer.
Gruß
Franz

Sub DruckenJahresuebersicht()
Dim Bereich As Range, Bild As Shape, wks As Worksheet, NextZelle As Range
Dim strBereich As String
Dim i As Integer
With Worksheets("Januar")
.Activate
Set Bereich = .Range("A1:BO" & .Cells(.Rows.Count, 3).End(xlUp).Row)
'Anzahl gefilterte Mitarbeiter zählen
.Unprotect myPwd
i = Intersect(Bereich.SpecialCells(xlVisible), _
Bereich.Columns(1)).Count - 1
.Protect myPwd
End With
'Anzahl Mitarbeiter überprüfen
If i > 18 Then
MsgBox "Es sind zuviele Mitarbeiter Ausgewählt! Bitte Filter setzen!", _
vbInformation, "Druckmenü """
Exit Sub
End If
' Temporäres Tabellenblatt erstellen
Application.ScreenUpdating = False
Worksheets.Add Before:=Worksheets(1)
Set wks = Worksheets(1)
On Error GoTo weiter
With wks
'Januar Kopieren
With Worksheets("Januar")
strBereich = .Range("A1:BO" & .Cells(.Rows.Count, 3).End(xlUp).Row).Address
.Range(strBereich).CopyPicture Appearance:=xlPrinter
End With
.Paste Destination:=.Range("A1")
Set Bild = .Shapes(.Shapes.Count)
Set NextZelle = .Cells(Bild.BottomRightCell.Row + 1, 1)
'Februar Kopieren
With Worksheets("Februar")
strBereich = .Range("A1:BO" & .Cells(.Rows.Count, 3).End(xlUp).Row).Address
.Range(strBereich).CopyPicture Appearance:=xlPrinter
End With
.Paste Destination:=NextZelle
Set Bild = .Shapes(.Shapes.Count)
Set NextZelle = .Cells(Bild.BottomRightCell.Row + 1, 1)
'März Kopieren
With Worksheets("März")
strBereich = .Range("A1:BO" & .Cells(.Rows.Count, 3).End(xlUp).Row).Address
.Range(strBereich).CopyPicture Appearance:=xlPrinter
End With
.Paste Destination:=NextZelle
Set Bild = .Shapes(.Shapes.Count)
Set NextZelle = .Cells(Bild.BottomRightCell.Row + 1, 1)
'April Kopieren
Worksheets("April").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A64")
'Mai Kopieren
Worksheets("Mai").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A85")
'Juni Kopieren
Worksheets("Juni").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A106")
'Juli Kopieren
Worksheets("Juli").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A127")
'August Kopieren
Worksheets("August").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A148")
'September Kopieren
Worksheets("September").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A169")
'Oktober Kopieren
Worksheets("Oktober").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A190")
'November Kopieren
Worksheets("November").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A211")
'Dezember Kopieren
Worksheets("Dezember").Range("A1:BO100").CopyPicture Appearance:=xlPrinter
.Paste Destination:=.Range("A232")
weiter:
On Error GoTo 0
'Ausdrucken
With .PageSetup
.LeftMargin = Application.InchesToPoints(0.31496062992126)
.RightMargin = Application.InchesToPoints(0.31496062992126)
.TopMargin = Application.InchesToPoints(0.78740157480315)
.BottomMargin = Application.InchesToPoints(0.78740157480315)
.Orientation = xlPortrait
.Zoom = 70
End With
'.PrintOut
Application.Dialogs(xlDialogPrint).Show
'Temporäres Tabellenblatt wieder löschen
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
Set wks = Nothing: Set Bild = Nothing: Set NextZelle = Nothing
Set Bereich = Nothing
Menüleiste.AktuellerMonat
Application.ScreenUpdating = True
End Sub
Sub DruckenJahresuebersichtVariante()
Dim Bereich As Range, Bild As Shape, wks As Worksheet, NextZelle As Range
Dim strBereich As String
Dim i As Integer
With Worksheets("Januar")
.Activate
Set Bereich = .Range("A1:BO" & .Cells(.Rows.Count, 3).End(xlUp).Row)
'Anzahl gefilterte Mitarbeiter zählen
.Unprotect myPwd
i = Intersect(Bereich.SpecialCells(xlVisible), _
Bereich.Columns(1)).Count - 1
.Protect myPwd
End With
'Anzahl Mitarbeiter überprüfen
If i > 18 Then
MsgBox "Es sind zuviele Mitarbeiter Ausgewählt! Bitte Filter setzen!", _
vbInformation, "Druckmenü """
Exit Sub
End If
' Temporäres Tabellenblatt erstellen
Application.ScreenUpdating = False
Worksheets.Add Before:=Worksheets(1)
Set wks = Worksheets(1)
On Error GoTo weiter
With wks
Set NextZelle = .Cells(1, 1)
For i = 1 To 12
'Monate Kopieren
With Worksheets(Format(DateSerial(Year(Date), i, 1), "MMMM"))
strBereich = .Range("A1:BO" & .Cells(.Rows.Count, 3).End(xlUp).Row).Address
.Range(strBereich).CopyPicture Appearance:=xlPrinter
End With
.Paste Destination:=NextZelle
Set Bild = .Shapes(.Shapes.Count)
Set NextZelle = .Cells(Bild.BottomRightCell.Row + 1, 1)
Next
weiter:
On Error GoTo 0
'Ausdrucken
With .PageSetup
.LeftMargin = Application.InchesToPoints(0.31496062992126)
.RightMargin = Application.InchesToPoints(0.31496062992126)
.TopMargin = Application.InchesToPoints(0.78740157480315)
.BottomMargin = Application.InchesToPoints(0.78740157480315)
.Orientation = xlPortrait
.Zoom = 70
End With
'.PrintOut
Application.Dialogs(xlDialogPrint).Show
'Temporäres Tabellenblatt wieder löschen
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
Set wks = Nothing: Set Bild = Nothing: Set NextZelle = Nothing
Set Bereich = Nothing
Menüleiste.AktuellerMonat
Application.ScreenUpdating = True
End Sub


Anzeige
AW: Mehrere Tballenblätter dynamisch drucken
01.10.2007 14:25:00
Roland
Hallo Franz
erstmals herzlichen Dank für Deine Bemühungen. Beide Varianten funktionieren soweit. Leider ergibt sich durch die dynamische Lösung ein weiteres Problem mit dem Seitenumbruch.
Wie ist es möglich zu verhindern, dass ein "Bild" im Seitenumbruch geteilt wird? Das heisst, wenn ein "Bild" auf der Seite nicht komplett Platz hat, wird es auf die nächste "geschrieben"
Besten Dank für die erneute Hilfe.
Gruss
Roland

AW: Mehrere Tballenblätter dynamisch drucken
01.10.2007 15:33:00
fcs
Hallo Roland,
dann müssen nach dem Einrichten des Seitenformats die Seitenumbrüche geprüft werden und ggf. am Beginn eines Bilds manuelle Wechsel eingefügt werden.
Ich hab an passender Stelle entsprechende Zeilen eingefügt.
Gruß
Franz
Hier der Auszug aus der Prozedur:

'Ausdrucken
With .PageSetup
.LeftMargin = Application.InchesToPoints(0.31496062992126)
.RightMargin = Application.InchesToPoints(0.31496062992126)
.TopMargin = Application.InchesToPoints(0.78740157480315)
.BottomMargin = Application.InchesToPoints(0.78740157480315)
.Orientation = xlPortrait
.Zoom = 70
End With
'Seitenwechsel prüfen und ggf. manuelle Wechsel einfügen
For i = 1 To .Shapes.Count
Set Bild = .Shapes(i)
Set NextZelle = Bild.TopLeftCell
For Zeile = NextZelle.Row + 1 To Bild.BottomRightCell.Row
If .Rows(Zeile).PageBreak = xlPageBreakAutomatic Then
NextZelle.EntireRow.PageBreak = xlPageBreakManual
Exit For
End If
Next
Next
'.PrintOut
Application.Dialogs(xlDialogPrint).Show
'Temporäres Tabellenblatt wieder löschen
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
Set wks = Nothing: Set Bild = Nothing: Set NextZelle = Nothing
Set Bereich = Nothing
Menüleiste.AktuellerMonat
Application.ScreenUpdating = True
End Sub


Anzeige
AW: Mehrere Tballenblätter dynamisch drucken
01.10.2007 15:54:00
Roland
Hallo Franz
besten Dank für Deine schnelle Hilfe.
Leider ist die Variable "Zeile" nicht definiert und mir ist nicht ganz klar als was sie definiert werden muss.
kannst Du mir hier nochmals behilflich sien?
Besten Dank

AW: Mehrere Tballenblätter dynamisch drucken
01.10.2007 17:29:08
fcs
Hallo Roland,
Zeile ist die Zeilennummer in der Tabelle. Normalerweise wird diese als Long deklariert, wenn man weiss dass es nicht mehr als ca. 32000 sind dann kann man auch Integer nehmen.

Dim i As Integer, Zeile as Long


Gruß
Franz

AW: Mehrere Tballenblätter dynamisch drucken
01.10.2007 18:15:36
Roland
Hallo Franz
Herzlichen Dank für die Infos. Habe dank Dir wieder etwas dazugelernt. Funktioniert jetzt alles bestens.
Gruss
Roland
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige