Druckbereich

Bild

Betrifft: Druckbereich
von: Armin
Geschrieben am: 17.11.2003 10:28:21

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

Bild


Betrifft: AW: Druckbereich
von: Andi_H
Geschrieben am: 17.11.2003 11:01:16

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


Bild


Betrifft: AW: Druckbereich
von: Armin
Geschrieben am: 17.11.2003 12:09:19

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


Bild


Betrifft: AW: Druckbereich
von: Andi_H
Geschrieben am: 17.11.2003 12:27:08

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


Bild


Betrifft: AW: Druckbereich
von: Armin
Geschrieben am: 17.11.2003 15:30:22

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



Bild


Betrifft: AW: Druckbereich
von: Andi_H
Geschrieben am: 17.11.2003 16:34:53

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


Bild


Betrifft: AW: Druckbereich
von: Armin
Geschrieben am: 17.11.2003 17:52:53

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.


Bild


Betrifft: AW: Druckbereich
von: Andi_H
Geschrieben am: 18.11.2003 09:46:03

lade mal deine Datei hoch, dann schau ich mir das mal an.


Bild

Beiträge aus den Excel-Beispielen zum Thema " Druckbereich"