excelvba

Excel macro that synchronizes zoom and position in structurally identical worksheets


Goal: I tried to write an Excel macro that synchronizes zoom and position in structurally identical worksheets to improve workflow.

Input, Progress: The macro (see below) works, considers worksheets that should not be synchronized (exceptional worksheets). According to debug messages I implemented the macro seems to work, but there never was a visible effect when using the worksheets.

Problem: Whatever I do, after my macro is finished, Excel reloads or sets its own saved values (probably hidden saved values) - negating everything that I have done.

Does anyone have an idea how to make it work? I would like to refrain from using a manually used button (although this has made it work since the macro is manually reactivated after excel re-sets the values after my macro initially after worksheet change.

(*) the code for ThisWorksheet:

' input in "Thisworksheet" 
Dim savedZoom As Double   'saved zoom
Dim savedScrollRow As Long 'saved scrollrow 
Dim savedScrollCol As Long 'saved scrollcol

' Function: True = Expectionalsheet (exceptional worksheets dont get synchronized)
Private Function IsExceptionalsheet (ByVal Sheetname As String) As Boolean
    Select Case Sheetname
        Case "Worksheet1", "Worksheet2", "Worksheet3" ' <-- enter names of exceptional worksheets here
            IsExceptionalsheet = True
        Case Else
            IsExceptionalsheet = False
    End Select
End Function

Private Sub Workbook_Open()
    ' Standard values are set
    savedZoom = 100
    savedScrollRow = 1
    savedScrollCol = 1
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    Debug.Print "DEACTIVATE: " & Sh.Name & " | Exception? " & IsExceptionalsheet(Sh.Name)
    
    ' Save only if NO exceptional worksheet
    If Not IsExceptionalsheet(Sh.Name) Then
        With ActiveWindow
            savedZoom = .Zoom
            savedScrollRow = .ScrollRow
            savedScrollCol = .ScrollColumn
        End With
        Debug.Print "Saved: Zoom=" & savedZoom & _
                    " Row=" & savedScrollRow & _
                    " Col=" & savedScrollCol
    End If
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Debug.Print "ACTIVATE: " & Sh.Name & " | Exception? " & IsExceptionalsheet(Sh.Name)
    
    ' Use only if NO exceptional worksheet
    If Not IsExceptionalsheet(Sh.Name) Then
        With ActiveWindow
            .Zoom = savedZoom
            .ScrollRow = savedScrollRow
            .ScrollColumn = savedScrollCol
        End With
        Debug.Print "Applied: Zoom=" & savedZoom & _
                    " Row=" & savedScrollRow & _
                    " Col=" & savedScrollCol
    End If
End Sub

And this is the code for a module named modsync (so that one has global variables):

Option Explicit

Public savedZoom As Double
Public savedScrollRow As Long
Public savedScrollCol As Long

Public Sub Setview()
    On Error Resume Next
    
    ' Jump to a different position to make effect visible
    ActiveSheet.Cells(1, 1).Select
    
    ' set Zoom 
    ActiveWindow.Zoom = savedZoom
    
    ' set Scroll position 
    ActiveWindow.ScrollRow = savedScrollRow
    ActiveWindow.ScrollColumn = savedScrollCol
    
    ' Jump to saved cell
    ActiveSheet.Cells(savedScrollRow, savedScrollCol).Select
    
    Debug.Print "Applied after delay: Zoom=" & savedZoom & _
                " Row=" & savedScrollRow & _
                " Col=" & savedScrollCol
End Sub

Debug text:

DEACTIVATE: S2 | Exception? False
Saved: Zoom=115 Row=27 Col=9
ACTIVATE: S1 | Exception? False
DEACTIVATE: S1 | Exception? False
Saved: Zoom=174 Row=28 Col=1
ACTIVATE: S2 | Exception? False

Solution

  • This functionality already exists in Excel. It is called (in English) View side-by-side (under the View menu) and used together with Synchronous scrolling, it supports synchronous scrolling and zooming.

    It is possible to enable it with a macro too, with something in the lines of:

    ThisWorkbook.Windows.CompareSideBySideWith "Book2"
    

    It can then be stopped with

    ThisWorkbook.Windows.BreakSideBySide
    

    From there you can add an event to sheets you want to sync, as workbook events like the code in your question or as application events if you want to put things in an addin rather than in 1 or several workbooks.
    Also, you must have noticed both macros tend to change the windows positions. This is easily mitigated by adding a few lines to manage the windows.

    When everything is put together, it gives this code to enable the side-by-side view on sheets you want to compare:

    Private Sub Worksheet_Activate()
        Dim name_other As String, workbook_other As Workbook
        name_other = "Book2"
        Set workbook_other = Application.Workbooks(name_other)
        If workbook_other Is Nothing Then Exit Sub
    
        Dim xm, ym, wm, hm, xo, yo, wo, ho
        With workbook_other.Windows(1)
            xo = .Left
            yo = .Top
            wo = .Width
            ho = .Height
        End With
        With Windows
            With .Item(1)
                xm = .Left
                ym = .Top
                wm = .Width
                hm = .Height
            End With
            .CompareSideBySideWith workbook_other.Windows(1).Caption
            With .Item(1)
                .Left = xm
                .Top = ym
                .Width = wm
                .Height = hm
            End With
        End With
        With workbook_other.Windows(1)
                .Left = xo
                .Top = yo
                .Width = wo
                .Height = ho
        End With
    End Sub
    
    

    And its opposite to sheets you don't:

    Private Sub Worksheet_Activate()
        Dim name_other As String, workbook_other As Workbook
        name_other = "Book2"
        Set workbook_other = Application.Workbooks(name_other)
        If workbook_other Is Nothing Then Exit Sub
    
        Dim xm, ym, wm, hm, xo, yo, wo, ho
        With workbook_other.Windows(1)
            xo = .Left
            yo = .Top
            wo = .Width
            ho = .Height
        End With
        With Windows
            With .Item(1)
                xm = .Left
                ym = .Top
                wm = .Width
                hm = .Height
            End With
            .BreakSideBySide
            With .Item(1)
                .Left = xm
                .Top = ym
                .Width = wm
                .Height = hm
            End With
        End With
        With workbook_other.Windows(1)
                .Left = xo
                .Top = yo
                .Width = wo
                .Height = ho
        End With
    End Sub
    
    

    And I get pretty much what you described.