excel vba冻结窗格而不选择

ibrsph3r  于 2022-12-30  发布在  其他
关注(0)|答案(9)|浏览(306)

我在Excel中有一个VBA脚本,它可以冻结Excel工作表的窗格,但我很好奇,想知道是否可以在不先选择范围的情况下执行此操作。下面是冻结第1行到第7行的代码:

ActiveSheet.Range("A8").Select
ActiveWindow.FreezePanes = True

有什么建议吗?

ztyzrc3y

ztyzrc3y1#

拆分的问题是,如果用户解冻窗格,窗格将保持拆分状态(我找不到一种方法来关闭拆分,同时保持窗格冻结)。
这可能太明显/简单了,但是如果只是保存当前选择,然后重新选择呢?

Sub FreezeTopRow()
    
    'First save the current selection to go back to it later
    Dim rngOriginalSelection As Range
    Set rngOriginalSelection = Selection
    
    'Change selection to A2 to make .FreezePanes work
    ActiveSheet.Range("A2").Select
    ActiveWindow.FreezePanes = True

    'Change selection back to original
    rngOriginalSelection.Select

End Sub
whhtz7ly

whhtz7ly2#

这是我用的...

Public Sub FreezeTopRowPane(ByRef MyWs As Excel.Worksheet, _
                            Optional ByVal AfterRowNr As Integer = 1)

Dim SavedWS As Worksheet
Dim SavedUpdating As Boolean

SavedUpdating = Application.ScreenUpdating      'save current screen updating mode

Set SavedWS = ActiveSheet                       'save current active sheet

Application.ScreenUpdating = False              'turn off screen updating
MyWs.Activate                                   'activate worksheet for panes freezing
ActiveWindow.FreezePanes = False                'turn off freeze panes in case 
With ActiveWindow
    .SplitColumn = 0                            'set no column to split
    .SplitRow = AfterRowNr                      'set the row to split, default = row 1
End With
ActiveWindow.FreezePanes = True                 'trigger the new pane freezing

SavedWS.Activate                                'restore previous (saved) ws as active

Application.ScreenUpdating = SavedUpdating      'restore previous (saved) updating mode

End Sub
ngynwnxp

ngynwnxp3#

我用.Select和. activate做了一个冻结的计时测试。

Dim numLoops As Long
Dim StartTime, LoopTime As Long
numLoops = 1000

Debug.Print ("Timing test of numloops:" & numLoops)

StartTime = Timer

For I = 0 To numLoops
        targetSheet.Activate
    With ActiveWindow
    If .FreezePanes Then .FreezePanes = False
        .SplitColumn = 2
        .SplitRow = 1
        .FreezePanes = True
    End With

Next I

LoopTime = Timer
Debug.Print ("Total time of activate method:" & Format((LoopTime - StartTime) / 86400, "hh:mm:ss"))
StartTime = Timer

For I = 0 To numLoops
        targetSheet.Select
        Application.Range("C2").Select
        Application.ActiveWindow.FreezePanes = True
Next I

LoopTime = Timer
Debug.Print ("Total time of select method:" & Format((LoopTime - StartTime) / 86400, "hh:mm:ss"))

这是结果。

Timing test of numloops:1000 
Total time of activate method:00:00:39 
Total time of select method:00:00:01

如您所见,.Select的速度要快得多。

bfrts1fy

bfrts1fy4#

使用查看►冻结窗格►冻结顶行命令记录自己,这是.FreezePanes的结果。

With ActiveWindow
    If .FreezePanes Then .FreezePanes = False
    .SplitColumn = 0
    .SplitRow = 1
    .FreezePanes = True
End With

因此,无论ActiveCell property是什么,修改.SplitColumn和/或.SplitRow属性都应该可以做到这一点。

jutyujz0

jutyujz05#

关于冻结窗格有很多错误,我添加了我自己的答案,所以我会在这里找到它,而不必在下次重新发明它。

Public Sub FreezePanesAt(rngDataTopLeft As Range)
    Dim wndCurrent As Window
    
    For Each wndCurrent In rngDataTopLeft.Worksheet.Parent.Windows
        With wndCurrent
            .FreezePanes = False
            If Not ((rngDataTopLeft.Row = 1) And (rngDataTopLeft.Column = 1)) Then
                .ScrollRow = 1
                .ScrollColumn = 1
                .SplitRow = rngDataTopLeft.Row - 1
                .SplitColumn = rngDataTopLeft.Column - 1
                .FreezePanes = True
            End If
        End With
    Next
End Sub

示例用法:

FreezePanesAt ThisWorkbook.Worksheets("Sheet1").Range("B3")
FreezePanesAt ThisWorkbook.Names("Header").RefersToRange
  • 输入参数是右下窗格的左上角单元格;我认为这是最常见的用例:您知道要拆分的范围,而不关心它在哪个工作簿/工作表/窗口中
  • 如果输入参数在第一行/第一个单元格中但不在A1中,则将只有两个窗格; A1是一个特例,但是Excel会在当前视图的中心分割窗口,我阻止了这一点,因为我想不出任何情况下这将是有意的
  • 它循环访问附加到工作簿/工作表的所有窗口;如果同一工作簿有多个窗口(名称为"MyWorkbook:1"),或者Excel在崩溃后尝试(通常失败)修复工作簿(名称为"MyWorkbook [Repaired]"),则索引到Application.WindowsWindows(Thisworkbook.Name))不会导致错误
  • 它考虑到窗格可能已经被冻结并且用户/另一宏可能已经滚动到工作簿中的位置,并且窗口中的左上单元格不是A1
dluptydi

dluptydi6#

我发现前面的答案只适用于loopingtabs的一些工作表。我发现下面的代码适用于tablooped的每个工作表(目标是单个workbook),尽管workbookactiveworkbook
简而言之:

With Application.Windows(DataWKB.Name) 
    Application.Goto ws.Cells(4, 5)
    .SplitColumn = 4
    .SplitRow = 3
    .FreezePanes = True
End With

代码,因为它是在我的Sub:(请注意,我在这个子模块中做了更多的格式设置,我试图将其删除,只留下这里需要的代码)

Sub Format_Final_Report()
Dim DataWKB As Workbook
Set DataWKB = Workbooks("Report.xlsx")
Dim ws As Worksheet

Dim tabCNT As Long
Dim tabName As String
tabCNT = DataWKB.Sheets.Count

For i = 1 To tabCNT
    Set ws = DataWKB.Worksheets(i)
    tabName = ws.Name

    With Application.Windows(DataWKB.Name)
        Application.Goto ws.Cells(4, 5)
        .SplitColumn = 4
        .SplitRow = 3
        .FreezePanes = True
    End With

Next i

End Sub

希望这能在将来为某人节省一些研究时间。

anhgbhbe

anhgbhbe7#

我需要能够正确地重新冻结窗格(特别是在创建新窗口时),而不丢失activecell或弄乱可见范围。这花了很多时间,但我认为我有一些坚实的工作:

Sub FreezePanes(nbLignes As Integer, nbColonnes As Integer, Optional ByVal feuille As Worksheet)
    If feuille Is Nothing Then Set feuille = ActiveSheet Else feuille.Activate
    Error GoTo erreur
    With ActiveWindow
        If .View = xlNormalView Then
            If .FreezePanes Then .FreezePanes = False
            If .Split Then .Split = False

            .SplitColumn = nbColonnes
            .SplitRow = nbLignes

            If .Panes.Count = 4 Then 'rows and columns frozen
                .Panes(1).ScrollRow = 1
                .Panes(1).ScrollColumn = 1
                .Panes(2).ScrollRow = 1 'top right pane
                .Panes(3).ScrollColumn = 1 'bottom left pane
            ElseIf nbLignes > 0 Then .Panes(1).ScrollRow = 1
            ElseIf nbColonnes > 0 Then .Panes(1).ScrollColumn = 1
            Else: GoTo erreur
            End If

            .FreezePanes = True
        End If
    End With
    Exit Sub
erreur:
    Debug.print "Erreur en exécutant le sub 'FreezePanes " & nbLignes & ", " & nbColonnes & ", '" & feuille.Name & "' : code #" & Err.Number & Err.Description
End Sub
lfapxunr

lfapxunr8#

我知道这很老了,但是我发现了一个可能有用的小细节......正如ChrisB所说,SplitColumn/SplitRow值表示当前可见窗口的拆分BUT上方/左侧的最后一个单元格。

Application.Goto Worksheets(2).Range("A101"), True
With ActiveWindow
 .SplitColumn = 0
 .SplitRow = 10
 .FreezePanes = True
End With

拆分将在行110和111之间进行,而不是行10和11之间进行。
编辑以进行澄清并添加更多信息:
我的观点是,这些值是左上角单元格的偏移量,而不是单元格的地址,因此,ChrisB在主要答案下的12月4日18:34的注解只有在第1行在Activewindow中可见时才有效。
关于这一点还有几点:
1.使用Application.后藤并不一定要将您要转到的单元格放在左上角
1.使用.后藤时放在左上角的单元格可以取决于excel窗口的大小、当前的缩放级别等(因此相当随意)
1.这是可能的有这分割被放置以致你不能看见他们或什至滚动在这可见的窗口(if .FreezePanes = true).例如:

Application.Goto Worksheets(1).Range("A1"), True  
With ActiveWindow  
 .SplitColumn = 100  
 .SplitRow = 100  
 .FreezePanes = True  
End With

CETAB可能会在他们的回答中处理这个问题。

wvt8vs2t

wvt8vs2t9#

是的,如果您的可见窗口不包括单元格A1,则ActiveWindow.ScrollRow = 1ActivWindow.ScrollColumn = 1是FreezePane的必备项。
如果通过选择行4或单元格A4冻结行1:3,并且单元格A3不可见,则FreezePanes函数将在可见窗口的中心冻结窗口。
同样,如果选择了单元格B4,并且A列不可见,则仅冻结行1:3(A列不冻结)。同样,如果行1:3不可见,则仅冻结A列。如果A列和行1:3都不可见,则FreezePanes函数将在可见窗口的中心冻结窗口。

相关问题