Microsoft Excel

Herbers Excel/VBA-Archiv

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Makro zum ein- und entfrieren

Betrifft: Makro zum ein- und entfrieren von: Thms Drng
Geschrieben am: 06.08.2014 09:42:37

Hallo Forum,

ich habe ein sehr "breites" Tabellenblatt und es wäre aufgrund des Inhalts sehr praktisch, wenn beim Öffnen von diesem Blatt, ab Zeile und Spalte F10 "eingefroren" wird, so dass deren Inhalte beim scrolen sichtbar bleiben. Sobald aber nach "rechts" über die Spalte "AP" hinaus gescrolt wird, hätte ich gerne, dass die "Einfrierung" aufgehoben wird. Kann man hierfür ein Makro ohne großen Aufwand machen? Ich habe leider keine Kenntnisse in VBA.

LG
Thomas

  

Betrifft: Edit: Makro zum ein- und entfrieren von: Thms Drng
Geschrieben am: 06.08.2014 10:29:09

Wenn möglich, sollte im Anschluss dann ab Spalte CT und Zeile 11 fixiert werden


  

Betrifft: AW: Edit: Makro zum ein- und entfrieren von: Rudi Maintaire
Geschrieben am: 06.08.2014 11:03:51

Hallo,
reines Scrollen löst kein Ereignis aus.

Gruß
Rudi


  

Betrifft: AW: Edit: Makro zum ein- und entfrieren von: Thms Drng
Geschrieben am: 06.08.2014 11:12:47

Hi Rudi,

verstehe. Eine Möglichkeit wäre ja dann, dass man eine Zelle "klickt/aktiviert" die das Makro dann ausführt?


LG


  

Betrifft: AW: Edit: Makro zum ein- und entfrieren von: Robert
Geschrieben am: 06.08.2014 11:24:05

Hallo,

in den Code des Tabellenblatts:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Zelle As Range
 If Target.Column > 43 Then
    ActiveWindow.FreezePanes = False
    Target.Select
 Else
    Set Zelle = Target
        ActiveSheet.Cells(10, 6).Select
        ActiveWindow.FreezePanes = True
    Zelle.Select
 End If
End Sub



  

Betrifft: AW: Edit: Makro zum ein- und entfrieren von: Rudi Maintaire
Geschrieben am: 06.08.2014 11:41:42

Hallo Robert,
die Select rufen aber wieder Worksheet_SelectionChange auf!!!

Gruß
Rudi


  

Betrifft: AW: Edit: Makro zum ein- und entfrieren von: Thms Drng
Geschrieben am: 06.08.2014 11:42:28

Hi Robert,

danke für Deine Mühe! Wenn ich das tue, stürzt mein Excel aber leider ab, sobald ich in eine Zelle klicke. Woran könnte das liegen? (Habe einige Spalten auch ausgeblendet, hängt es damit evtl. zusammen?)


  

Betrifft: AW: Edit: Makro zum ein- und entfrieren von: Robert
Geschrieben am: 06.08.2014 11:49:33

Danke Für den Hinweis Rudi, die endlosschleife hab ich übersehen.

Fixed:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
Dim Zelle As Range
 If Target.Column > 43 Then
    ActiveWindow.FreezePanes = False
    Target.Select
 Else
    Set Zelle = Target
        ActiveSheet.Cells(10, 6).Select
        ActiveWindow.FreezePanes = True
    Zelle.Select
 End If
Application.EnableEvents = True
End Sub
Viele Grüße
Robert


  

Betrifft: AW: Edit: Makro zum ein- und entfrieren von: fcs
Geschrieben am: 06.08.2014 11:55:29

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("AP1").Column
            intStatusFrozen = 1
          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 < Range("AP1").Column
          If intStatusFrozen <> 1 Then
            Call prcFreezePaneYes(strZelle:="G11", objRange:=Target)
            intStatusFrozen = 1
          End If
        Case Is < Range("CT1").Column
          If intStatusFrozen <> 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("AP1").Column
        Set Zelle = Target
        ActiveWindow.FreezePanes = False
        Range("G11").Select
        ActiveWindow.FreezePanes = True
        Zelle.Select
    Case Is < Range("CT1").Column
      ActiveWindow.FreezePanes = False
      Target.Select
    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



  

Betrifft: AW: Edit: Makro zum ein- und entfrieren von: Thms Drng
Geschrieben am: 06.08.2014 12:21:35

Hallo Franz,

super! Herzlichen Dank für die Codes!!!
Beides funktioniert für meine Zwecke einwandfrei! Hoffentlich bin ich nicht der einzige der davon profitieren kann/wird!

Beste Grüße
Thomas