Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
24.04.2024 18:49:56
Anzeige
Archiv - Navigation
344to348
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
344to348
344to348
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Brauche dringend Hilfe bei meinen Makro

Brauche dringend Hilfe bei meinen Makro
03.12.2003 10:49:32
Scotty
Hallo alle zusammen,

habe bei folgenden Makro Probleme:


Sub MultiSpaltenDruck()
Dim rng As Range
Dim iRow As Integer, iCountR As Integer
Dim iRowT As Integer, iColT As Integer
Dim iCounter As Integer
Application.ScreenUpdating = False
Set rng = Range("A1").CurrentRegion
iCountR = 36
Workbooks.Add 1
iRow = 1
iRowT = 1
iColT = 1
Do While iRow <= rng.Rows.Count
For iCounter = 1 To 2
rng.Range(rng.Cells(iRow, 1), _
rng.Cells(iRow + iCountR - 1, 6)).Copy _
Cells(iRowT, iColT)
iRow = iRow + iCountR
iColT = iColT + 7
Next iCounter
ActiveSheet.PrintPreview
iColT = 1
Loop
ActiveWorkbook.Close savechanges:=False
Application.ScreenUpdating = False
End Sub


Habe 6 schmale Spalten im Querformat. Beim ausdrucken sollen die 6 Spalten der Seite 2 mit auf Seite 1 usw. Ansich funktioniert das Makro. Es gibt nur 2 Probleme: Mein Arbeitsblatt ist im Querformat. Das Makro zeigt aber bei der Druckvorschau Hochformat an. Die Spalten passen dann nicht auf das Blatt. 2. Problem: Die Tabelle geht über mehrere Seiten. Das Makro (Siehe oben:Tabellenumbruch Zeile 36)funktioniert nur auf den ersten beiden Seiten. Wenn man die Zeile 'iCountR = 36' irgendwie ändern könnte, das jede beschriebene Seite am Seitenende "umgebrochen" wird, wäre das Makro perfekt.

Vielleicht kann mir jemand helfen. Bin für jeden Vorschalg dankbar.
Gruß Scotty

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Brauche dringend Hilfe bei meinen Makro
06.12.2003 17:55:44
Beni
Hallo Scotty,
ich habe es getestet und hat funktioniert.
Gruss Beni

https://www.herber.de/bbs/user/2345.xls


Sub MultiSpaltenDruck()
Dim rng As Range
Dim iRow As Integer, iCountR As Integer
Dim iRowT As Integer, iColT As Integer
Dim iCounter As Integer
Application.ScreenUpdating = False
Set rng = Range("A1").CurrentRegion
iCountR = 36
Workbooks.Add 1
Columns("A:O").ColumnWidth = 7 '<<<<<<<
iRow = 1
iRowT = 1
iColT = 1
Do While iRow <= rng.Rows.Count
For iCounter = 1 To 2
rng.Range(rng.Cells(iRow, 1), _
rng.Cells(iRow + iCountR - 1, 6)).Copy _
Cells(iRowT, iColT)
iRow = iRow + iCountR
iColT = iColT + 7
Next iCounter
ActiveSheet.PageSetup.Orientation = xlLandscape '<<<<<<
ActiveSheet.PrintPreview
iColT = 1
Loop
ActiveWorkbook.Close savechanges:=False
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Brauche dringend Hilfe bei meinen Makro
06.12.2003 17:56:30
Beni
Hallo Scotty,
ich habe es getestet und hat funktioniert.
Gruss Beni

https://www.herber.de/bbs/user/2345.xls


Sub MultiSpaltenDruck()
Dim rng As Range
Dim iRow As Integer, iCountR As Integer
Dim iRowT As Integer, iColT As Integer
Dim iCounter As Integer
Application.ScreenUpdating = False
Set rng = Range("A1").CurrentRegion
iCountR = 36
Workbooks.Add 1
Columns("A:O").ColumnWidth = 7 '<<<<<<<
iRow = 1
iRowT = 1
iColT = 1
Do While iRow <= rng.Rows.Count
For iCounter = 1 To 2
rng.Range(rng.Cells(iRow, 1), _
rng.Cells(iRow + iCountR - 1, 6)).Copy _
Cells(iRowT, iColT)
iRow = iRow + iCountR
iColT = iColT + 7
Next iCounter
ActiveSheet.PageSetup.Orientation = xlLandscape '<<<<<<
ActiveSheet.PrintPreview
iColT = 1
Loop
ActiveWorkbook.Close savechanges:=False
Application.ScreenUpdating = True
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige