Fenster fixieren - Daten Gültigkeit

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Manfred,
ich hab das Ganze jetzt mal erweitert (auch im eigenen Interesse):
Es wird die Excelversion abgefragt (da die gleiche Datei ja möglicherweise auch mit verschiedenen Versionen genutzt wird), zudem bezieht sich der Code auf alle Gültigkeitsfelder, die INNERHALB der Fixierung liegen. Dazu wird im Code bei "FixCell" die Zelle angegeben, bei der fixiert wird.
Ich bin kein VBA-Experte - daher lässt sich das vielleicht auch noch vereinfachen - aber so geht es schon mal (Code gehört in das Modul der Tabelle):
Option Explicit


Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim Aw As Window
Dim FixCell As Range
Dim AppVers As String
Dim Oc As Range
Set Aw = ActiveWindow
Set FixCell = [b3] 'Zelle der Fixierung
AppVers = Application.Version 'Excelversion
On Error GoTo fehler
If AppVers <> "8.0e" Then Exit Sub 'gilt nur für Excel97
If Target.Validation.InCellDropdown = True Then
If Target.Row < FixCell.Row Or Target.Column <> FixCell.Column Then Aw.FreezePanes = False
End If
Exit Sub
fehler:
If Aw.Panes.Count > 1 Then Exit Sub 'Wenn Fixierung aktiv, Sub beenden
Application.EnableEvents = False
Set Oc = Target 'aktive Zelle zwischenspeichern
FixCell.Select 'Das gehört zu dem einen Prozent, wo es ohne SELECT nicht geht
Aw.FreezePanes = True 'Fixierung wieder an alter Stelle setzen
Oc.Select 'wieder aktive Zelle ansteuern
Application.EnableEvents = True
End Sub

Grüße Boris

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) Dim Aw As Window Dim FixCell As Range Dim AppVers As String Dim Oc As Range Set Aw = ActiveWindow Set FixCell = [b3] 'Zelle der Fixierung AppVers = Application.Version 'Excelversion On Error GoTo fehler If AppVers <> "8.0e" Then Exit Sub 'gilt nur für Excel97 If Target.Validation.InCellDropdown = True Then If Target.Row < FixCell.Row Or Target.Column < FixCell.Column Then Aw.FreezePanes = False End If Exit Sub fehler: If Aw.Panes.Count > 1 Then Exit Sub 'Wenn Fixierung aktiv, Sub beenden Application.EnableEvents = False Set Oc = Target 'aktive Zelle zwischenspeichern FixCell.Select 'Das gehört zu dem einen Prozent, wo es ohne SELECT nicht geht Aw.FreezePanes = True 'Fixierung wieder an alter Stelle setzen Oc.Select 'wieder aktive Zelle ansteuern Application.EnableEvents = True 'Kann demnach hier auch entfallen End Sub

Beliebteste Forumthreads (12 Monate)

Fenster fixieren - Daten Gültigkeit

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread