Drucken daneben

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Drucken daneben

08.12.2006 10:07:25

Bertam

Muß mal probieren

08.12.2006 10:19:55

Walter

Leider nicht

08.12.2006 10:35:51

Walter

AW: Leider nicht

08.12.2006 10:44:26

Bertam

AW: Drucken daneben

08.12.2006 11:47:37

Jens

Danke -)

08.12.2006 14:04:33

Walter

Hallo Walter!
Ich habe auch so ein Problem gehabt und es wie folgt gelöst (Der Code ist vielleicht nicht ganz optimal, läuft aber soweit bei mir):
Excel hat keine Möglichkeit einer Zwei- oder Mehrspalten-Anordnung wie z. B. Word. Ich möchte in meinem Fall pro Blatt 100 Zeilen haben und zwar zweispaltig. Für den Ausdruck benötigt man ein neues Blatt.
Also habe ich vom Ursprungsblatt die ersten 100 Zeilen genommen und ins neue Blatt kopiert, danach Zeile 101 bis 200 und diese ins neue Blatt NEBEN die ersten 100 kopierten gesetzt.
Danach kopiere ich die Zeilen 201-300 und setze sie ins neue Blatt ab Zeile 101 usw. usw.
Das ganze erledigt mein Makro, das du dir anpassen kannst:


Private Sub Ausdruck_Einzelseite()
Dim z As Integer
Dim y As Integer
Dim Ende As Range
Dim n As String
Dim i As Long
Application.ScreenUpdating = False
' auszudruckende Seite in temporäres Blatt übertragen
On Error Resume Next
n = ActiveSheet.Name
ActiveSheet.Copy after:=Sheets(Sheets.Count) 'Anlegen eines temp. Blattes
ActiveSheet.Name = "listing " & n
Range("B1").Activate
z = 101
y = 200
Do Until ActiveCell.Value = "" And ActiveCell.Offset(1, 0) = ""
If IsEmpty(Ende) Then Exit Sub
Range(ActiveCell.Offset(100, -1), ActiveCell.Offset(199, 0)).Copy
Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0, 2)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Rows(z & ":" & y).Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(0, 1).Activate
ActiveWindow.SelectedSheets.HPageBreaks.Add before:=ActiveCell
z = z + 100
y = y + 100
Loop
With ActiveSheet.PageSetup
.CenterFooter = ActiveSheet.Name
.RightFooter = "&8Seite &P" 'von &N
.LeftMargin = Application.InchesToPoints(0.7)
.RightMargin = Application.InchesToPoints(0.2)
.TopMargin = Application.InchesToPoints(0.4)
.BottomMargin = Application.InchesToPoints(0.4)
.HeaderMargin = Application.InchesToPoints(0.2)
.FooterMargin = Application.InchesToPoints(0.2)
.CenterVertically = False
.Zoom = 60
End With
i = ActiveSheet.UsedRange.Rows.Count
With ActiveSheet
.PageSetup.PrintArea = "$A$1:$F$" & i
.PrintPreview
End With
Application.DisplayAlerts = False
ActiveSheet.Delete 'Das temporäre Blatt wieder löschen
End Sub

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread