evtl. eine Krücke
13.10.2015 22:02:14
Michael
Hi Felix,
probier mal die Subs aus:
Option Explicit
Sub Rahmen_EinAus(ByRef Blatt As Worksheet, ByVal wert)
Dim hUm As Long, vUm As Long
Dim i&, j&
Dim pa As String
Dim pa_loX&, pa_loY&, pa_ruX&, pa_ruY&
pa = Blatt.PageSetup.PrintArea
If pa "" Then
pa_loX = Range(pa)(1).Column
pa_loY = Range(pa)(1).Row
pa_ruX = Range(pa)(Range(pa).Count).Column
pa_ruY = Range(pa)(Range(pa).Count).Row
hUm = Blatt.HPageBreaks.Count
vUm = Blatt.VPageBreaks.Count
With Blatt.Range(pa)
.Borders(xlEdgeLeft).LineStyle = wert
.Borders(xlEdgeTop).LineStyle = wert
.Borders(xlEdgeBottom).LineStyle = wert
.Borders(xlEdgeRight).LineStyle = wert
End With
For i = 1 To vUm
j = Blatt.VPageBreaks(i).Location.Column
Range(Blatt.Cells(pa_loY, j - 1), _
Blatt.Cells(pa_ruY, j)).Borders(xlInsideVertical).LineStyle = wert
Next
For i = 1 To hUm
j = Blatt.HPageBreaks(i).Location.Row
Range(Blatt.Cells(j - 1, pa_loX), _
Blatt.Cells(j, pa_ruX)).Borders(xlInsideHorizontal).LineStyle = wert
Next
End If
End Sub
Sub Einschalten()
Dim sh As Worksheet
Set sh = Sheets("Tabelle2")
Call Rahmen_EinAus(sh, xlContinuous)
End Sub
Sub Ausschalten()
Dim sh As Worksheet
Set sh = Sheets("Tabelle2")
Call Rahmen_EinAus(sh, xlNone)
End Sub
Die Sub Rahmen_EinAus, die die eigentliche Arbeit macht, erwartet als Parameter ein Tabellenblatt und entweder xlNone, das löscht die Rahmen, oder xlContinuous, das setzt sie - andere Parameter kannst Du ja bei Bedarf noch einfügen: eine Reihe davon zeigt Dir Excel an, wenn Du mit dem Makrorekorder aufzeichnest, wie Du irgendwo einen Rahmen malst.
Den Aufruf habe ich so gewählt, weil das flexibel ist und Du vermutlich die Datei sowieso in einer Schleife für den Druck aufbereitest á la
Sub alleBlätter()
Dim sh As Worksheet
For Each sh In Worksheets
MsgBox sh.Name
Next
End Sub
In dieser Schleife kannst Du das Malen der Rahmen dann anstelle der MsgBox positionieren.
Schöne Grüße,
Michael