Spaltenbreite an Seitenrand anpassen

[beavis76]

Hallo,

wir nutzen im Büro zahlreiche Excel-Tabellen, die einzelnen Zellen sind meist mit Rahmen versehen.
In der Kopfzeile ist unser Büro-Logo rechtsbündig abgelegt und der rechte Rand der letzten Spalte sollte immer bündig mit dem rechten Seitenrand bzw. bündig mit dem Büro-Logo abschließen.

Gibt es eine Funktion, die z.B. die Breite der rechten Tabellenspalte so anpasst, dass diese immer bis zum Seitenrand reicht?
Wenn ich nämlich in der Druckvorschau die Excel-Tabelle "auf 1 Seite breit anpassen" wähle kann es passieren, dass mir bei deultich zu breiten Spalten die Schriftgröße skaliert/verkleinert wird, damit die Tabelle auf eine Seite passt.

Momentan passen wir die letzte Spalte immer manuell so lange an, dass diese genau noch auf die voreingestellte Seitenbreite passt (ohne Anpassung und Skalierung der Schriftgrößen), aber vielleicht kennt hier jemand eine Funktion, mit der z.B. die Breite der "letzten" Spalte automatisch bis zum rechten Seitenrand reicht...

Ich hoffe, ich konnte mein Problem verständlich schildern, vielen Dank schon mal für Eure Ideen hierzu.

VG
Ralf.

[Klaus-Dieter]

Hallo Ralf,

Excel ist eine Tabellenkalkulation, kein Programm zur Gestaltung von Dokumenten. Deshalb muss man schon mit ein paar Unzulänglichkeiten leben.

[NobX]

Hallo Ralf,

hast Du den rechten Seitenrand in "Seite einrichten" bereits auf "0" gestellt? - Mehr geht soweit mir bekannt ist nicht.

Grüße
Norbert

[LuckyJoe]

Hallo Ralf,

wenn VBA für dich in Frage kommt, könnte man damit die Breite der letzten Spalte dynamisch anpassen, indem man die Summe aller Spaltenbreiten vor dem Ausdruck berechnen läßt.

[beavis76]

Hallo Ralf,

wenn VBA für dich in Frage kommt, könnte man damit die Breite der letzten Spalte dynamisch anpassen, indem man die Summe aller Spaltenbreiten vor dem Ausdruck berechnen läßt.

Hallo LuckyJoe,

ich will Makros / VBA nicht ausschließen, kenne mich damit jedoch nicht aus.
Wo muss ich die Programmierung eintragen und v.a. wie sähe die Programmierung aus...?

Danke,
Ralf.

---

Hallo Ralf,

hast Du den rechten Seitenrand in "Seite einrichten" bereits auf "0" gestellt? - Mehr geht soweit mir bekannt ist nicht.

Grüße
Norbert

Hallo Norbert,

beim rechten Seitenrand = 0 rutscht zwar unser Logo der Kopfzeile nach rechts, aber die Breite der letzten Spalte muss ich dennoch manuell anpassen bzw. so lange immer etwas breiter machen, dass es gerade noch auf die Seite passt und nicht eine zweite Seite entsteht...

[Kuwer]

Hallo Ralf,

folgender Code kommt in das schon vorhandene VBA-Modul DieseArbeitsmappe:

Code:

Private Sub Workbook_BeforePrint(Cancel As Boolean)
  Dim lngC As Long, lngVP As Long
  With ActiveSheet
    If .Name = "Daten" Then 'Namen entsprechend anpassen
      lngC = 23 'Spalte 23 = W
      lngVP = .VPageBreaks.Count
      Application.ScreenUpdating = False
      Do While .VPageBreaks.Count = lngVP
        .Columns(lngC).ColumnWidth = .Columns(lngC).ColumnWidth + 0.1
      Loop
      '.Columns(lngC).ColumnWidth = .Columns(lngC).ColumnWidth - 0.1
      Application.ScreenUpdating = True
    End If
  End With
End Sub

Gruß Uwe

[beavis76]

Hallo Uwe,

vielen Dank für den Code.
Ich habe ihn im VBA-Modul ergänzt - erkenne jedoch bei der Spaltenbreite keine Veränderung bzw. die Spaltenbreite passt sich nicht automatisch an die verfügbare Seitenbreite an...
Was habe ich falsch gemacht?

VG
Ralf.

[schauan]

Hallöchen,

hast Du entsprechend den Hinweisen im Code den Blattnamen und die Spaltenzahl angepasst?
Der Code verbreitert allerdings die Spalten und macht sie nicht schmaler. Ich hab das mal kombiniert:

Code:

Private Sub Workbook_BeforePrint(Cancel As Boolean)
  Dim lngC As Long, lngVP As Long, lngPWidth As Long
  With ActiveSheet
    If .Name = "Daten" Then 'Namen entsprechend anpassen
      lngC = 23 'Spalte 23 = W
      lngVP = .VPageBreaks.Count
      Call Break
      Application.ScreenUpdating = False
      Do While .VPageBreaks.Count > 0
        .Columns(lngC).ColumnWidth = .Columns(lngC).ColumnWidth - 0.1
      Loop
      Do While .VPageBreaks.Count = 0
        .Columns(lngC).ColumnWidth = .Columns(lngC).ColumnWidth + 0.1
      Loop
      Application.ScreenUpdating = True
    End If
  End With
End Sub