Position (Tabelle/Markierung) merken u. wieder anw
Peter
Dieses Forum (Wolli) hat mir geholfen, nachfolgenden Code zu entwickeln. Dieser Code fixiert - auch wenn mehrere Fenster einer Datei offen sind, die einzelnen Fenster so, dass der Drucktitel (Zeilen und Spalten) fixiert werden.
Ich möchte noch eine kleinere Verbesserung erzielen, und zwar so, dass nach dem Aktivieren eines Fensters die aktive Tabelle / Markierung gespeichert wird und nach Ablaufen des Codes wieder aktiviert wird.
Ich nehme an, dass ich einen Befehl nach wndFenster.Activate einfügen muss und dann vor Next wndFenster. Aber mir ist nicht klar, wie ich die aktive Tabelle / Markierung zwischenspeichern und dann wieder aufrufen kann.
Wer kann mir helfen?
Danke und Gruss, Peter
For Each wndFenster In ActiveWorkbook.Windows
wndFenster.Activate
.
Next wndFenster
.
..
Sub Bereiche_fixieren()
''Fenster fixieren anhand von Druckbereich
''''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
'Aktuell aktives Fenster speichern
Set actWin = ActiveWindow
For Each wndFenster In ActiveWorkbook.Windows
wndFenster.Activate
'Aktives Fenster minimieren (damit Flackern unterbunden werden kann -
'kann nicht mit ScreenUdating = False gemacht werden, da sonst
'Fensterfixierung nicht funktioniert)
Application.WindowState = xlMinimized
' 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
' Fenster wieder in der ursprünglichen Grösse anzeigen
Application.WindowState = xlNormal
End Sub