Question

除基于分辨率的自动更改外，我找不到任何vba缩放，但是是否可以根据最远的带有文本的列来自动调整自定义缩放级别？

 Sub Workbook_Open()
    ActiveWindow.Zoom = 100  'also you can change to other size
End Sub

奖金代码：

要将滚动条重置到最左侧，因此它正在查看A / Row1列，此代码有效：)我将其放置在“重置”用户按钮上。

'Scroll to a specific row and column
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollColumn = 1

谢谢。

Answer 1

尝试以下代码：

Function FindFurthestColumn(S As Worksheet) As Integer
    
    Dim CellsWithContent As Long
    CellsWithContent = WorksheetFunction.CountA(S.Cells)
    
    If CellsWithContent = 0 Then
        FindFurthestColumn = 1
        Exit Function
    End If
    
    Dim CellsCount As Long
    Dim j As Integer
    Do
        j = j + 1
        CellsCount = CellsCount + WorksheetFunction.CountA(S.Columns(j))
    Loop Until CellsCount = CellsWithContent
    
    FindFurthestColumn = j
End Function

Function CellIsVisible(cell As Range) As Boolean
    CellIsVisible = Not Intersect(ActiveWindow.VisibleRange, cell) Is Nothing
End Function

Sub ZoomVisibleCells()
    
    Application.ScreenUpdating = False
    
    Dim LastColumn As Integer
    LastColumn = FindFurthestColumn(ActiveSheet)
    
    Dim SplitCell As Range
    If ActiveWindow.Split = True Then
        Set SplitCell = Cells(ActiveWindow.SplitRow + 1, ActiveWindow.SplitColumn + 1)
        ActiveWindow.FreezePanes = False
    End If
    
    Dim Zoom As Integer
    For Zoom = 400 To 10 Step -1
        ActiveWindow.ScrollRow = 1
        ActiveWindow.ScrollColumn = 1
        ActiveWindow.Zoom = Zoom
        If CellIsVisible(ActiveSheet.Cells(1, LastColumn + 1)) Then
            Exit For
        End If
    Next Zoom
    
    If Not SplitCell Is Nothing Then
        SplitCell.Activate
        ActiveWindow.FreezePanes = True
    End If
    
    Application.ScreenUpdating = True
End Sub

CellIsVisible函数的信用： https://stackoverflow.com/a/11943260/14370454

自动缩放视图以适合表格中的活动/可见单元格？

1 个答案: