将所有选定的纸张设置为相同的可见区域

时间:2018-05-11 18:45:22

标签: excel vba excel-vba

尝试将一个宏设置为将所有选定的工作表设置为与活动工作表中相同的单元格。

示例:如果活动工作表上的左上角单元格为L76,则运行此宏将设置所有选定的工作表,以将L76显示为左上角的单元格。

将这些代码拼凑在一起,在网上找到但在VBA中没有足够先进的例子,以使其有效。

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

参考文献:

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

VBA Macro To Select Same Cell on all Worksheets

3 个答案:

答案 0 :(得分:1)

试试这个:

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

答案 1 :(得分:1)

也许这会有所帮助。根据第一张纸设置其他纸张的左上角单元格。

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

答案 2 :(得分:1)

此过程为所有选定工作表的活动工作表设置相同的可见范围。它会排除选择中的任何图表工作表并调整所选工作表的缩放以确保所有工作表具有相同的可见区域。

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