title image


Smiley GESCHLOSSENER Rahmen um jede Seite bei langen Tabellen
Hallo,



eine Option dies einzustellen gibt es nicht. Es ist aber möglich, vor dem Drucken via VBA die entsprechenden Umrandungen einzufügen.



Du kannst den Code in ein Modul einfügen und dann vor jedem Drucken über ein "before print" ereingnis automatisch aufrufen.



ACHTUNG.



Wenn es noch andere RAhmen in der Tabelle gibt, dann werden diese entfernt! WEnn dies nicht geht fällt mir nur ein zum Drucken das Blatt zu kopieren, dann die gewünschten RAhmen zu setzen und dann das Blatt wieder zu löschen.





Sub RahmenUmJedeSeite()

Dim Seite As Range

Dim Zeile As Long, i As Long, VonZeile As Long, BisZeile As Long, Tabellenbreite As Long

Application.ScreenUpdating = False



    'alle alten Rahmen entfernen

    Cells.Borders(xlDiagonalDown).LineStyle = xlNone

    Cells.Borders(xlDiagonalUp).LineStyle = xlNone

    Cells.Borders(xlEdgeLeft).LineStyle = xlNone

    Cells.Borders(xlEdgeTop).LineStyle = xlNone

    Cells.Borders(xlEdgeBottom).LineStyle = xlNone

    Cells.Borders(xlEdgeRight).LineStyle = xlNone

    Cells.Borders(xlInsideVertical).LineStyle = xlNone

    Cells.Borders(xlInsideHorizontal).LineStyle = xlNone





    Tabellenbreite = [iv1].End(xlToLeft).Column 'Tabellenbreite in der Titelzeile (ggf Zeile anpassen)

    BisZeile = 0

    

    ActiveWindow.View = xlPageBreakPreview 'komischerweise kann es in der normalansicht zu fehlern kommen

    For i = 1 To ActiveSheet.HPageBreaks.Count

        VonZeile = BisZeile + 1

        BisZeile = ActiveSheet.HPageBreaks(i).Location.Row - 1

        Set Seite = Range(Cells(VonZeile, 1), Cells(BisZeile, Tabellenbreite))

        

        With Seite.Borders(xlEdgeLeft)

            .LineStyle = xlContinuous

            .Weight = xlMedium

            .ColorIndex = xlAutomatic

        End With

        With Seite.Borders(xlEdgeTop)

            .LineStyle = xlContinuous

            .Weight = xlMedium

            .ColorIndex = xlAutomatic

        End With

        With Seite.Borders(xlEdgeBottom)

            .LineStyle = xlContinuous

            .Weight = xlMedium

            .ColorIndex = xlAutomatic

        End With

        With Seite.Borders(xlEdgeRight)

            .LineStyle = xlContinuous

            .Weight = xlMedium

            .ColorIndex = xlAutomatic

        End With

    Next

ActiveWindow.View = xlNormalView

Application.ScreenUpdating = True

End Sub

 Code eingefügt mit Syntaxhighlighter 1.16



liebe grüsse Georg
Beiträge zu Excel 2002 in Verbindung mit Win XP

 A
1Tabellentool
2von StrgAltEntf


Gibts hier


geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: