Setting all selected sheets to same visible area

2019-12-16 20:12发布

Attempting a macro that will set all selected sheets to have same cells visible as in the active sheet.

Example: if top-left cell is L76 on active sheet, then running this macro will set all selected worksheets to show L76 as the top left cell.

Cobbled this code together from examples found online but not sufficiently advanced in VBA to make it work.

Sub SetAllSelectedSheetsToSameRowColCell()
    Dim rngSel As Range
    Dim intScrollCol As Integer
    Dim intScrollRow As Long
    Dim oSheet As Object
    If TypeName(Sh) = "Worksheet" Then
        Set oSheet = ActiveSheet
        Application.EnableEvents = False 'Unsure what this line is for
        Sh.Activate
        With ActiveWindow
            intScrollCol = .ScrollColumn
            intScrollRow = .ScrollRow
            Set rngSel = .RangeSelection
        End With
        oSheet.Activate
        Application.EnableEvents = True
    End If

    'Loop thru rest of selected sheets and update to have same cells visible
    Dim oWs As Worksheet
    For Each oWs In Application.ActiveWindow.SelectedSheets
        On Error Resume Next
        oWs.Range(rngSel.Address).Select
            .ScrollColumn = intScrollCol
            .ScrollRow = intScrollRow
    Next

End Sub

References:

https://excel.tips.net/T003860_Viewing_Same_Cells_on_Different_Worksheets.html

VBA Macro To Select Same Cell on all Worksheets

3条回答
Evening l夕情丶
2楼-- · 2019-12-16 20:34

Maybe this will help. Sets the top left cell of other sheets depending on the first sheet.

Sub Macro1()

Dim r As Range, ws As Worksheet

Sheets(1).Activate
Set r = ActiveWindow.VisibleRange.Cells(1)

For Each ws In Worksheets
    If ws.Index > 1 Then
        ws.Activate
        ActiveWindow.ScrollRow = r.Row
        ActiveWindow.ScrollColumn = r.Column
    End If
Next ws

End Sub
查看更多
干净又极端
3楼-- · 2019-12-16 20:49

Try this:

Sub ResetAllSheetPerspectives()
    Dim ws As Worksheet
    Dim lRow As Long
    Dim lCol As Long
    Dim dZoom As Double

    lRow = ActiveWindow.ScrollRow
    lCol = ActiveWindow.ScrollColumn
    dZoom = ActiveWindow.Zoom

    For Each ws In Application.ActiveWindow.SelectedSheets
        ws.Activate
        ActiveWindow.Zoom = dZoom
        Application.Goto ws.Cells(lRow, lCol), True
    Next ws
End Sub
查看更多
我想做一个坏孩纸
4楼-- · 2019-12-16 20:56

This procedure sets the same visible range as the active worksheet for all selected worksheets. It excludes any Chart sheet in the selection and adjusts the zoom of the selected sheets to ensure all worksheets have the same visible area.

Sub SelectedWorksheets_ToSameVisibleRange()
Dim ws As Worksheet
Dim oShs As Object, oSh As Object
Dim sRgAddrs As String

    On Error Resume Next
    Set ws = ActiveSheet
    On Error GoTo 0
    If ws Is Nothing Then
        MsgBox "Active sheet must be a worksheet type" & String(2, vbLf) _
            & String(2, vbTab) & "Process will be cancelled.", _
            vbCritical, "Worksheets Common Range View"
        Exit Sub
    End If

    With ActiveWindow
        Set oShs = .SelectedSheets
        sRgAddrs = .VisibleRange.Address    'Get address of Active Sheet visible range
    End With

    For Each oSh In oShs
        If TypeName(oSh) = "Worksheet" And oSh.Name <> ws.Name Then     'Excludes any chart sheet and the active sheet
            With oSh.Range(sRgAddrs)
                Application.Goto .Cells, 1      'Activate Worksheet targeted visible range
                ActiveWindow.Zoom = True        'Zoom Worksheet to make visible same range as the "active worksheet"
                Application.Goto .Cells(1), 1   'Activate 1st cell of the visible range
    End With: End If: Next

    ws.Select       'Ungroups selected sheets

    End Sub
查看更多
登录 后发表回答