Dynamic Freeze Pane / Frozen Row in Excel

问题:

I needed a dynamic frozen header row in Excel as the sheet I was working with had Several Tables that were large and were easier to understand if they were located on the same sheet.

But after searching endlessly I could not find a solution as there is no event for scrolling and scrolling doesn't change the active cell.

Thankfully I figured out a work around.

回答1:

I was able to come up with an acceptable solution for my dilemma after searching for how to Identify the first visible row in the active window running across

MSDN: Identify First Visible Row of Active Window

I was then able to take that code and convert it to a function that could be used in combination with a Timer event that is only activated on the sheet I need the frozen row.

Sheet Code:

Private Sub Worksheet_Activate()
    StartFreezePaneTimeRefresh
End Sub

Private Sub Worksheet_Deactivate()
    StopFreezePaneTimeRefresh
End Sub

Dynamic Freeze Pane Module Code:

Private RefreshTime

Sub SetFreezePane()
    'Check if correct worksheet is active
    If ActiveWorkbook.ActiveSheet.Name = "Data" Then
        If IdentifyTopVisibleRow < 227 Then
            'Check if Frozen Row is the same as the Range to be Copied
            If Range("A1") <> Range("AN1") Then
                'Copy New Headers for Frozen Row
                Range("AN1:BU1").Copy
                Range("A1").PasteSpecial xlPasteValues
            End If
        ElseIf IdentifyTopVisibleRow > 227 Then
            'Check if Frozen Row is the same as the Range to be Copied
            If Range("A1") <> Range("AN2") Then
                'Copy New Headers for Frozen Row
                Range("AN2:BU2").Copy
                Range("A1").PasteSpecial xlPasteValues
            End If
        End If
    Else
        StopFreezePaneTimeRefresh
    End If
End Sub

Sub StartFreezePaneTimeRefresh()
    Call SetFreezePane
    RefreshTime = Now + TimeValue("00:00:01")
    Application.OnTime RefreshTime, "StartFreezePaneTimeRefresh"
End Sub

Sub StopFreezePaneTimeRefresh()
    On Error Resume Next
    Application.OnTime RefreshTime, "StartFreezePaneTimeRefresh", , False
End Sub

Public Function IdentifyTopVisibleRow() As Long
    'This code was found on MSDN at
    'https://social.msdn.microsoft.com/Forums/en-US/a6cff632-e123-4190-8556-d9f48af8fe9a/identify-first-visible-row-of-scrolled-excel-worksheet?forum=isvvba
    Dim lngTopRow As Long ' top row
    Dim lngNumRows As Long ' number of visible rows
    Dim lngLeftCol As Long ' leftmost column
    Dim lngNumCols As Long ' number of visible columns
    With ActiveWindow.VisibleRange
        lngTopRow = .Row
        lngNumRows = .Rows.Count
        lngLeftCol = .Column
        lngNumCols = .Columns.Count
    End With
    IdentifyTopVisibleRow = lngTopRow
End Function

The code works by first checking if the correct sheet is active and if it is then it checks the top most visible row every second.

If the top row is Greater or Lesser than the beginning rows of each table it then will check to see if the first header is already set to prevent it from changing the values over and over.

If not it changes the Frozen Row values based upon the users location in the workbook.

Notes:

The change is delayed by 1 second but that is acceptable for what I am doing this for.

The sheet I am using this on is view only as this would constantly shift the focus to the first row if you have an idea on how to set the first row values without changing selection that would make this work great.