AW: Edit: Makro zum ein- und entfrieren
06.08.2014 11:55:29
fcs
Hallo Thomas,
hier eine etwas kompliziertere Lösung, deren Code unter DieseArbeitsmappe eingefügt werden muss. Die Fixierung wird nicht bei jeder Zellselektion geändert, sonder nur wenn die aktive Zelle in einen anderen Spaltenbereich wandert.
Bei Roberts Lösung müssen im Makro vorübergehend die Ereignismakros deaktiviert werden, dann sollte Excel auch nicht mehr in eine Endlosschleife geraten und abstürzen.
Gruß
Franz
'Code im VBA-Editor unter "DieseArbeitsmappe" der Datei
Option Explicit
Private intStatusFrozen As Integer 'Merker für Fensterfixierung
Private Const strSheet As String = "Tabelle1" 'Name des Blatts mit spezieller Fensterfixierung
Private Sub prcMerkenStatus(ByVal objSh As Object)
intStatusFrozen = 0
Select Case objSh.Name
Case strSheet
If Application.ActiveWindow.FreezePanes = False Then
intStatusFrozen = 2
Else
Select Case ActiveCell.Column
Case Is = Range("CT1").Column
intStatusFrozen = 3
End Select
End If
Case Else
'do nothing
End Select
End Sub
Private Sub prcFreezePaneYes(strZelle As String, objRange As Range)
Dim objAktiv As Range
Set objAktiv = ActiveCell
Application.ActiveWindow.FreezePanes = False
Range("A1").Select
Range(strZelle).Select
Application.ActiveWindow.FreezePanes = True
objRange.Select
objAktiv.Activate
End Sub
Private Sub prcFreezePaneNo(objRange As Range)
Dim objAktiv As Range
Set objAktiv = ActiveCell
Application.ActiveWindow.FreezePanes = False
objRange.Select
objAktiv.Activate
End Sub
Private Sub Workbook_Open()
'Frozen-Status merken beim Öffnen der Datei
Call prcMerkenStatus(objSh:=ActiveSheet)
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'Frozen-Status merken wenn Blatt aktiviert/selektiert wird
Call prcMerkenStatus(objSh:=Sh)
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Select Case Sh.Name
Case strSheet
'Fensterfixierung wechseln, wenn die aktive Zelle um bestimmte Spalten pendelt
Application.EnableEvents = False
Select Case ActiveCell.Column
Case Is 1 Then
Call prcFreezePaneYes(strZelle:="G11", objRange:=Target)
intStatusFrozen = 1
End If
Case Is 2 Then
Call prcFreezePaneNo(objRange:=Target)
intStatusFrozen = 2
End If
Case Is >= Range("CT1").Column
If intStatusFrozen 3 Then
Call prcFreezePaneYes(strZelle:="A11", objRange:=Target)
intStatusFrozen = 3
End If
End Select
Application.EnableEvents = True
Case Else
'do nothing
End Select
End Sub
Roberts Lösung angepasst:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Zelle As Range
Application.EnableEvents = False
Select Case Target.Column
Case Is = Range("CT1").Column
Set Zelle = Target
ActiveWindow.FreezePanes = False
Range("A11").Select
ActiveWindow.FreezePanes = True
Zelle.Select
End Select
Application.EnableEvents = True
End Sub