Private Sub Worksheet_Change(ByVal Target As Range)
  
  Const MyChart = 1 ' Номер или "имя" диаграммы активного листа
  
  Dim chrt As Chart, rng As Range
  Set chrt = ChartObjects(MyChart).Chart
  
  ' Ось Y
  Set rng = Range(Split(chrt.SeriesCollection(1).Formula, ",")(2))
  If Not Intersect(Target, rng) Is Nothing Then
    With WorksheetFunction
      chrt.Axes(xlValue).MaximumScale = .Round(.Max(rng.Value), 0)
    End With
  End If
  
  ' Ось X
  Set rng = Range(Split(chrt.SeriesCollection(1).Formula, ",")(1))
  If Not Intersect(Target, rng) Is Nothing Then
    With WorksheetFunction
      chrt.Axes(xlCategory).MaximumScale = .Round(.Max(rng.Value), 0)
    End With
  End If
  
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
  Const MyChart = 1 ' Номер или "имя" диаграммы активного листа
  Dim chrt As Chart, rng As Range
  Set chrt = ChartObjects(MyChart).Chart
  Set rng = Range(Split(chrt.SeriesCollection(1).Formula, ",")(2))
  If Intersect(Target, rng) Is Nothing Then Exit Sub
  With WorksheetFunction
    chrt.Axes(xlValue).MaximumScale = .Round(.Max(rng.Value) + 0.5, 0)
    'chrt.Axes(xlValue).MinorUnit = .Round(.Min(rng.Value) / 4, 0)
  End With
End Sub

Sub HideNames()
' Скрыть имена
  Dim n As Name
  For Each n In Names
    n.Visible = False
  Next
  Application.ScreenUpdating = True
End Sub

Sub ShowNames()
' Отобразить имена
  Dim n As Name
  For Each n In Names
    n.Visible = True
  Next
  Application.ScreenUpdating = True
End Sub

Const Pi As Double = 3.14159265358979 + 3.10862446895044E-15

' ZVI:2022-04-07 https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&TID=148740

Option Explicit

' Passwords and departments names
Const PwdSh01 = "000" ' <-- Password of Sh01 for Admin
Const Dep1 = "Отдел1", PwdDep1 = "125"
Const Dep2 = "Отдел2", PwdDep2 = "238"

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  With Sh01
    .Unprotect PwdSh01
    On Error Resume Next
    .Protection.AllowEditRanges(Dep1).Delete
    .Protection.AllowEditRanges(Dep2).Delete
    On Error GoTo 0
    .Protect PwdSh01, DrawingObjects:=True, Contents:=True, Scenarios:=True, _
                      AllowFormattingCells:=True, AllowFiltering:=True, _
                      UserInterfaceOnly:=True
    Application.OnTime Now, "'" & Me.Name & "'!" & Me.CodeName & ".WbOpen"
  End With
End Sub

Private Sub Workbook_Open()
  Application.OnTime Now, "'" & Me.Name & "'!" & Me.CodeName & ".WbOpen"
End Sub

Private Sub WbOpen()
  
  Dim i As Long, j As Long
  
  With Sh01
    
    ' Unprotect Sh01
    .Unprotect PwdSh01
    
    ' Del AllowEditRanges of Dep1 & Dep2
    On Error Resume Next
    .Protection.AllowEditRanges(Dep1).Delete
    .Protection.AllowEditRanges(Dep2).Delete
    On Error GoTo 0
    
    ' Find last row
    j = .UsedRange.Rows.Count + 1000
    If j < 10000 Then j = 10000
    
    ' Protect actual range of Dep1
    i = .UsedRange.EntireRow.Columns("b").Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, SearchFormat:=False).Row
    .Protection.AllowEditRanges.Add Dep1, .Range("A" & i + 1 & ":I" & j), PwdDep1
    
    ' Protect actual range of Dep2
    i = .UsedRange.EntireRow.Columns("k").Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, SearchFormat:=False).Row
    .Protection.AllowEditRanges.Add Dep2, .Range("J" & i + 1 & ":O" & j), PwdDep2
    
    ' Protect Sh01
    .Protect PwdSh01, DrawingObjects:=True, Contents:=True, Scenarios:=True, _
                      AllowFormattingCells:=True, AllowFiltering:=True, _
                      UserInterfaceOnly:=True
    
  End With
End Sub

Sub Test1()
  ' For-Each-Next
  Dim rng As Range, cell As Range
  Set rng = Range("A1:B2")
  Debug.Print "Cell"
  For Each cell In rng.Cells
    Debug.Print cell.Address(0, 0)
  Next
End Sub

Sub Test2()
  ' Аналог For-Each-Next
  Dim i As Long, rng As Range
  Set rng = Range("A1:B2")
  Debug.Print "Item"
  For i = 1 To rng.Cells.Count
    Debug.Print rng.Item(i).Address(0, 0)
  Next
End Sub

#Const ALEXEY = True ' Менять здесь

#If ALEXEY Then
  Dim a As Long
#Else
  Dim b As Range
#End If

Sub Test()
#If ALEXEY Then
  Debug.Print TypeName(a)
  Dim c
  '...
#Else
  Debug.Print TypeName(b)
  Dim d
  '...
#End If
End Sub

Sub Test1()
  Dim n&
  n = 1 ' или вызов функции, меняющей n: Call Fn(n)
  If n = 1 Then
    Dim ЧегоНибудь
    ' И дальше весь код здесь
    '...
  Else
    Dim ЧегоНибудьДругое
    'И дальше весь код здесь
    '...
  End If
End Sub