Peter
Peter
Wolli hat mir am 16.7.2009 einen genialen Code geliefert, den ich etwas ergänzt habe.
In meiner xls-Datei werden - sofern in den einzelnen Tabellen vorhanden - alle Drucktitel fixiert - und das auch wenn mehrere Fenster der gleichen Datei offen sind.
Vielleicht lässt sich auch noch ein kleiner Schönheitsfehler ausmerzen:
Angenommen, in einer Tabelle sind folgende Drucktitel definiert:
A:C; 1:10
wenn nun vor der Ausführung des Makros in der entsprechenden Tabelle die Zeilen erst ab Zeile 20 ersichtlich sind und als erste Spalte z.B. nur Spalte E ersichtlich ist, werden nicht mehr die Drucktitel, sondern ein nach unten und rechts verschobener Bereich fixiert.
Habe nicht herausgefunden, wie ich das lösen kann.
Wer kann mir helfen?
Danke und Gruss, Peter
Option Explicit
Sub Bereiche_fixieren()
''Fenster fixieren anhand von Drucktitel
''''mit Ergänzungen durch Peter
Dim shBlatt As Worksheet, _
strZeilen As String, _
strSpalten As String, _
lngZeile As Long, _
lngSpalte As Long, _
wndFenster As Window
Dim actWsh As Object
Dim actWin As Object
Application.ScreenUpdating = False
'Aktuell aktives Fenster speichern
Set actWin = ActiveWindow
For Each wndFenster In ActiveWorkbook.Windows
wndFenster.Activate
' Aktuell aktives Blatt speichern
Set actWsh = ActiveSheet
'Alle Arbeitsblätter in der Mappe durchlaufen
For Each shBlatt In ActiveWorkbook.Worksheets
'Aktivieren
shBlatt.Activate
'Drucktitel (Zeilen und Spalten auslesen)
strZeilen = ActiveSheet.PageSetup.PrintTitleRows
strSpalten = ActiveSheet.PageSetup.PrintTitleColumns
'Ohne Drucktitel nichts ändern.
If strZeilen "" Or strSpalten "" Then
'Zeile bestimmen, oberhalb derer fixiert werden soll
If strZeilen = "" Then
lngZeile = 1
Else
lngZeile = Range(strZeilen).Rows(Range(strZeilen).Rows.Count).Row + 1
End If
'Spalte bestimmen, von der links fixiert werden soll
If strSpalten = "" Then
lngSpalte = 1
Else
lngSpalte = Range(strSpalten).Columns(Range(strSpalten).Columns.Count).Column + _
1
End If
'Eventuell bestehende Fixierung aufheben
wndFenster.FreezePanes = False
'Zelle wählen, fixieren
wndFenster.Activate
Cells(lngZeile, lngSpalte).Select
wndFenster.FreezePanes = True
End If
Next shBlatt
' Wieder zurück zum zuvor aktiven Blatt
actWsh.Activate
Next wndFenster
'wieder zurück zum zuvor aktiven Fenster
actWin.Activate
Application.ScreenUpdating = True
End Sub