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
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.