Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 00:42:03
Listbox mit gefilterten Daten füllen
24.04.2024 20:38:58
Summe mit Bedingung, nur letzte Ergebnisse anzeigen
24.04.2024 19:29:30
Formel filter
24.04.2024 18:49:56
merge & select
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
336to340
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
336to340
336to340
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Druckbereich

Druckbereich
17.11.2003 10:28:21
Armin
Hallo,

ich nutze unten stehendes Makro. Aufgabe des Makro ist es:

1. das Format auf A5 zu bringen,
2. den Text auf 65% der ursprünglichen Größe zu verkleinern und
3. nach der letzten Zeile mit Inhalt den Druckvorgang zu beenden.

D.h. also, dass das Makro erkennt, wo die letzte Zeile ist, in der etwas steht.
Ich würde nun gerne das Makro so abändern, dass es auch die letzte SPALTE erkennt und in den Druckbereich miteinschließt.
Die Größe ist bei all meinen Tabellen nämlich nicht das Problem. Die passen alle auf das A5-Format. Aber manchmal ist die letzte Spalte halt die Spalte F, dann wieder N oder R usw. Ich kann also einen Druckbereich nicht wirklich festlegen. Deshalb sollte das Makro das erkennen.

Ich wäre echt dankbar, wenn mir jemand helfen könnte, das Makro umzuschreiben.

Danke im Voraus!

Gruß

Armin



Sub A5Format()
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.590551181102362)
.RightMargin = Application.InchesToPoints(0.393700787401575)
.TopMargin = Application.InchesToPoints(0.590551181102362)
.BottomMargin = Application.InchesToPoints(0.590551181102362)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA5
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 65
.PrintErrors = xlPrintErrorsDisplayed
End With
Dim laR As Long
laR = Cells(Rows.Count, 2).End(xlUp).Row
ActiveSheet.PageSetup.PrintArea = "$A$1:$R$" & laR
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End Sub

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Druckbereich
17.11.2003 11:01:16
Andi_H
Hi Armin,
hab deine Nachfrage zum alten Thread schon gesehen, hatte aber noch keine Zeit,

hier der Code:


Sub A_DruckbereichDefinieren()
Dim i, x, lRow, lCol As Long
lRow = 0
For i = 1 To 256 Step 1
If IsEmpty(Cells(65536, i)) Then
If Cells(65536, i).End(xlUp).Row > lRow Then _
lRow = Cells(65536, i).End(xlUp).Row
Else
lRow = 65536
Exit For
End If
Next
For x = 256 To 1 Step -1
If IsEmpty(Cells(65536, x)) Then
If Cells(65536, x).End(xlUp).Row <> 1 Then
lCol = x
Exit For
End If
Else
lCol = x
Exit For
End If
Next
ActiveSheet.PageSetup.PrintArea = "$A$1:" & Cells(lRow, lCol).Address
Cells(lRow, lCol).Select
End Sub


Gruß

Andi
Anzeige
AW: Druckbereich
17.11.2003 12:09:19
Armin
Hi Andi,

klappt super!!! Besten Dank.

Nochmals eine letzte Frage: Ich habe das Makro nun in der Symbolleiste hinter einen Knopf gelegt. Ist es denn möglich, dass ich mit diesem einen Knopfdruck nicht nur die jeweilige Tabelle, sondern alle Tabellen in dieser Mappe in dem eingestellten Format ausdrucken kann?

Gruß

Armin
AW: Druckbereich
17.11.2003 12:27:08
Andi_H
Hi Armin,

jetzt wird jede Seite gedruckt:


Sub A_DruckbereichDefinieren()
Dim i, x, lRow, lCol As Long
Dim ws As Worksheet
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
ws.Select
lRow = 0
For i = 1 To 256 Step 1
If IsEmpty(Cells(65536, i)) Then
If Cells(65536, i).End(xlUp).Row > lRow Then _
lRow = Cells(65536, i).End(xlUp).Row
Else
lRow = 65536
Exit For
End If
Next
For x = 256 To 1 Step -1
If IsEmpty(Cells(65536, x)) Then
If Cells(65536, x).End(xlUp).Row <> 1 Then
lCol = x
Exit For
End If
Else
lCol = x
Exit For
End If
Next
ActiveSheet.PageSetup.PrintArea = "$A$1:" & Cells(lRow, lCol).Address
ActiveSheet.PrintOut
Next
Application.ScreenUpdating = True
End Sub


Grzuß
Andi
Anzeige
AW: Druckbereich
17.11.2003 15:30:22
Armin
Hallo Andy,

sorry, aber das funktioniert leider irgendwie nicht.

Fehlermeldung: Die Methode ´Select´für das Objekt ´_Worksheet´ ist fehlgeschlagen.

Das ist mein Code:


Sub A5Format()
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.590551181102362)
.RightMargin = Application.InchesToPoints(0.196850393700787)
.TopMargin = Application.InchesToPoints(0.590551181102362)
.BottomMargin = Application.InchesToPoints(0.590551181102362)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA5
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 65
.PrintErrors = xlPrintErrorsDisplayed
End With
Dim i, x, lRow, lCol As Long
Dim ws As Worksheet
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
ws.Select
lRow = 0
For i = 1 To 256 Step 1
If IsEmpty(Cells(65536, i)) Then
If Cells(65536, i).End(xlUp).Row > lRow Then _
lRow = Cells(65536, i).End(xlUp).Row
Else
lRow = 65536
Exit For
End If
Next
For x = 256 To 1 Step -1
If IsEmpty(Cells(65536, x)) Then
If Cells(65536, x).End(xlUp).Row <> 1 Then
lCol = x
Exit For
End If
Else
lCol = x
Exit For
End If
Next
ActiveSheet.PageSetup.PrintArea = "$A$1:" & Cells(lRow, lCol).Address
ActiveSheet.PrintOut
Next
Application.ScreenUpdating = True
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End Sub

Anzeige
AW: Druckbereich
17.11.2003 16:34:53
Andi_H
kann es sein das du ein Tabellenblatt ausgeblendet hast?? Dann kann man das nämlich nicht anwählen, code wie folgt ändern.

For Each ws In ThisWorkbook.Worksheets
if ws.visible = true then
ws.Select

lRow = 0

For i = 1 To 256 Step 1
If IsEmpty(Cells(65536, i)) Then
If Cells(65536, i).End(xlUp).Row > lRow Then _
lRow = Cells(65536, i).End(xlUp).Row
Else
lRow = 65536
Exit For
End If
Next

For x = 256 To 1 Step -1
If IsEmpty(Cells(65536, x)) Then
If Cells(65536, x).End(xlUp).Row <> 1 Then
lCol = x
Exit For
End If
Else
lCol = x
Exit For
End If
Next
ActiveSheet.PageSetup.PrintArea = "$A$1:" & Cells(lRow, lCol).Address
ActiveSheet.PrintOut
end if
Next
Application.ScreenUpdating = True
End Sub
Anzeige
AW: Druckbereich
17.11.2003 17:52:53
Armin
Hmmm.

Ich weiß nicht. Irgendwie wird beim Debuggen das "ws.select" gelb markiert. Keine Ahnung woran es liegt. :´O((

Oder ist das zwischen Exel 2000 und Excel 2002 unterschiedlich? Ich hab nämlich zwei Rechner mit unterschiedlichen Versionen.
AW: Druckbereich
18.11.2003 09:46:03
Andi_H
lade mal deine Datei hoch, dann schau ich mir das mal an.

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige