VBA Excel Markierte Zellen an Seite anpassen

Computer: Software & Programmierung Visual Basic
#1

Hallo Leute,

gibt es per Makro die Möglichkeit, eine Markierung so zu verzerren, dass sie auf einem Blatt ausgedruckt werden kann?
Bislang habe ich das folgende Problem: Meine Tabelle ist viel zu lang, um auf eine Seite zu passen. ich markiere also die Tabelle, füge den markierten Bereich in paint ein, kopiere dann das Bild wieder zurück in Excel und hebe dort das gesperrte Seitenverhältnis auf. Dann kann ich das Bild genau so verzerren, dass es auf eine Seite passt. Gibts dafür nicht eine elegantere Lösung per VBA?

Danke für Eure Hilfe.

#2

gibt es per Makro die Möglichkeit, eine Markierung so zu
verzerren, dass sie auf einem Blatt ausgedruckt werden kann?
Bislang habe ich das folgende Problem: Meine Tabelle ist viel
zu lang, um auf eine Seite zu passen. ich markiere also die
Tabelle, füge den markierten Bereich in paint ein, kopiere
dann das Bild wieder zurück in Excel und hebe dort das
gesperrte Seitenverhältnis auf. Dann kann ich das Bild genau
so verzerren, dass es auf eine Seite passt. Gibts dafür nicht
eine elegantere Lösung per VBA?

Hallo Achim,

die Hilfe sagt dazu:

With Worksheets("Sheet1").PageSetup
 .Zoom = False
 .FitToPagesTall = 1
 .FitToPagesWide = 1
End With

Gruß
Reinhard

#3

Hallo Reinhard,

vielen Dank für Deinen Tipp. Leider behandelt dieser Code das komplette Tabellenblatt, also auch das, was man gar nicht ausdrucken will. Ich hatte schon folgendes versucht:

With Sheets(„Tabellenname“).Range(„E1:CH32“).Setup

funzt leider nicht…Gruß Achim

#4

Hallo Achim,

Leider behandelt dieser Code das
komplette Tabellenblatt, also auch das, was man gar nicht
ausdrucken will.

kein Problem, dann erzeugt man per Vba ein neues Blatt, kopiert dahin den gewünschten Bereich, druckt das neue Blatt aus und löscht es dann.
Oder man kann sogar nur einen festgelegten bzw. markierten bereich ausdrucken. Weiß grad nicht auswendig.

Ich hatte schon folgendes versucht:

With Sheets(„Tabellenname“).Range(„E1:CH32“).Setup

Lass das „code“ weg, um Einrückungen bei der Codedarstellung zu erhalten nimm den pre-HtmlTag.

Was soll „Setup“ sein?

Ich verstehe grad überhauptnicht was du da ausdrucken willst. Anfangs schreibst du von einer zu langen Tabelle, was ich aber nur 32 Zeilen nicht so erkennen kann.

Bei Range(„E1:CH32“) gehts aber um ca. 80 Spalten.
Also ist m.E. die Tabelle eher zu breit als zu lang.

Gruß
Reinhard

#5

… sorry, ich meinte natürlich eine zu BREITE Tabelle.

#6

… sorry, ich meinte natürlich eine zu BREITE Tabelle.

Hallo Achim,

probiers mal so:

Sub tt()
With Worksheets("Tabelle2")
 With .PageSetup
 .PrintArea = "$E$1:blush:CH$32"
 .Zoom = False
 .FitToPagesTall = 1
 .FitToPagesWide = 1
 End With
 .PrintOut
End With
End Sub

Gruß
Reinhard

#7

Hallo Reinhard,

ich habe es jetzt mal ausprobiert. Jetzt wird die Tabelle zwar auf einer Seite ausgedruckt, jedoch wurde das Seitenverhätnis zu 100 % eingehalten, das heißt, durch die große Breite der Tabelle ist diese im ausgedruckten Zustand nur ein halbes Blatt hoch. Ich würde die Tabelle aber gern auf die Seitenmaße verzerren, also genau eine Seite breit und eine Seite hoch…ist das möglich?

Gruß Achim

1 Like
#8

ich habe es jetzt mal ausprobiert. Jetzt wird die Tabelle zwar
auf einer Seite ausgedruckt, jedoch wurde das Seitenverhätnis
zu 100 % eingehalten, das heißt, durch die große Breite der
Tabelle ist diese im ausgedruckten Zustand nur ein halbes
Blatt hoch. Ich würde die Tabelle aber gern auf die Seitenmaße
verzerren, also genau eine Seite breit und eine Seite
hoch…ist das möglich?

Hallo Achim,

das Hochkomma sagt, diese zeile ist Kommentar = wird nicht ausgeführt.
Während der Testphase empfiehlt es sich Printpreview und nicht printout zu nehmen, wozu ein sinnloser Papierberg.

Probiers mal so, mit der Zeilenhöhe (RowHeight) = 30 kannste ja rumexperimentieren.

Sub tt()
With Worksheets("Tabelle1")
 .Rows("1:32").RowHeight = 30
 With .PageSetup
 .PrintArea = "$E$1:blush:CH$32"
 .Zoom = False
 .FitToPagesTall = 1
 .FitToPagesWide = 1
 End With
 '.PrintOut
 .PrintPreview
End With
End Sub

Gruß
Reinhard

#9

Hallo Reinhard,

vielen Dank für Deine Antwort.
Ich glaube aber, dass es mir nicht gelungen ist, das eigentliche Problem darzustellen, deswegen schildere ich jetzt einfach mal meine bisherige Vorgehensweise: Ich möchte eine unheimlich breite Tabelle auf einer Seite ausdrucken, ohne Einhaltung des Seitenverhältnisses. Ich markiere also die ganze Tabelle, kopiere sie, und füge sie danach in Paint ein. Dann öffne ich ein neues Exceldokument und füge dann dort die Grafik aus Paint ein. Nun hebe ich bei den Grafikeigenschaften die Sperre des Seitenverhältnisses auf und ziehe die Grafik manuell bis an die Seitenränder. Dadurch wird die Grafik zwar verzerrt, passt aber auf eine Seite.

Wie kann ich den Paintschritt weglassen und die Tabelle so verzerren, dass sie auf eine Seite zum drucken passt?

Dir noch einen schönen Feiertag.

Gruß

#10

Hallo Reinhard,

habs mittlerweile selbst hinbekommen, den Code poste ich im Anschluss. Ist zwar nicht die eleganteste Lösung, trifft mein Problem aber ziemlich genau.

Viele Grüße, Achim

Dim Höhe As Double
ActiveSheet.Select
Range(„A1“).Select
zanzahl = 36
ReDim dummyh(zanzahl) As Double
For i = 1 To zanzahl
dummyh(i) = ActiveCell.Rows(„1:1“).EntireRow.RowHeight
Höhe = Höhe + dummyh(i)
Next i

Dim Breite As Double
ActiveSheet.Select
Range(„A1“).Select
sanzahl = 78
ReDim dummyb(sanzahl) As Double
For i = 1 To sanzahl
dummyb(i) = ActiveCell.Columns(„A:A“).EntireColumn.ColumnWidth
Breite = Breite + dummyb(i)
Next i

Dim oDia As Object, oChartArea As Object, oChartPic As Object
Dim iBreite As Single, iHoehe As Single, RetVal As Boolean, oBlatt As Object
Dim oBook As Object
Dim sTempPfad As String
On Error GoTo Fehler
Application.ScreenUpdating = False
Dim oShape As Range, sName As String

Set oShape = ActiveSheet.Range(„B1:BZ35“)

ActiveSheet.Range(„B1:BZ35“).CopyPicture 1, 2
Set oBook = Application.Workbooks.Add
Set oDia = oBook.ActiveSheet.ChartObjects.Add(0, 0, Breite * 8, Breite * 8 / 1.42)
Set oChartArea = oDia.Chart
oDia.Activate
With oChartArea
.ChartArea.Select
.Paste
Set oChartPic = .Pictures(1)
End With
With oChartPic
.Left = 0
.Top = 0
iBreite = Breite * 8
iHoehe = Breite * 8 / 1.42
End With
With oDia
.Border.LineStyle = xlNone
.Width = 3000
.Height = 2121
End With

RetVal = oChartArea.PrintOut

If Not RetVal Then
MsgBox „Bild wurde nicht gedruckt“, vbExclamation
Else
End If
Aufraeumen:
On Error Resume Next
Set oChartPic = Nothing
Set oChartArea = Nothing
Set oDia = Nothing
oBook.Saved = True
oBook.Close
Set oBook = Nothing
Application.ScreenUpdating = True
Exit Sub

Fehler:
MsgBox „Fehler beim Druck!“, vbExclamation
Resume Aufraeumen