Option Explicit
Dim rng As Range
Private Sub hook()
        Dim obj As Object
        For Each obj In Me.ScrollBars.ShapeRange
            With obj.OLEFormat.Object
                Set rng = Union(IIf(rng Is Nothing, Range(.LinkedCell), rng), Range(.LinkedCell))
            End With
        Next
        For Each obj In Me.OLEObjects
            If TypeOf obj.Object Is MSForms.ScrollBar Then
                Set rng = Union(IIf(rng Is Nothing, Range(obj.LinkedCell), rng), Range(obj.LinkedCell))
            End If
        Next
        [A1].Formula = "=sum(" & rng.Address & ")"
End Sub
Private Sub Worksheet_Calculate()
        If rng Is Nothing Then Call hook
        With Application: .EnableEvents = False
            If .Average(rng) <> rng.Areas(1)(1, 1) Then
                rng.Value = IIf(.Min(rng) = .Median(rng), .Max(rng), .Min(rng))
            End If
        .EnableEvents = True: End With
End Sub

Option Explicit
Public col As Collection
Public Sub hook()
     Dim wsh As Worksheet, rng As Range, obj As Object, tmp$(), i&
     Set col = New Collection
     With Application: .EnableEvents = False: .ScreenUpdating = False
         For Each wsh In Sheets
             Set rng = Nothing
             If wsh.ScrollBars.Count Then
                 For Each obj In wsh.ScrollBars.ShapeRange
                     With obj.OLEFormat.Object
                         ReDim Preserve tmp(i)
                         tmp(i) = wsh.Range(.LinkedCell).Address(, , , True)
                         Set rng = Union(IIf(rng Is Nothing, Range(tmp(i)), rng), Range(tmp(i)))
                         i = i + 1
                     End With
                 Next
             End If
             For Each obj In wsh.OLEObjects
                 If TypeOf obj.Object Is MSForms.ScrollBar Then
                     ReDim Preserve tmp(i)
                     tmp(i) = wsh.Range(obj.LinkedCell).Address(, , , True)
                     Set rng = Union(IIf(rng Is Nothing, Range(tmp(i)), rng), Range(tmp(i)))
                     i = i + 1
                 End If
             Next
             col.Add rng, wsh.Name
         Next
         With ActiveSheet
             Sheets().Select
             [A1].Activate
             ActiveCell.Formula = "=sum(" & Join(tmp, ",") & ")"
             .Select
         End With
     .EnableEvents = True: .ScreenUpdating = True: End With
End Sub

Option Explicit
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
     Dim rr As Range, rg As Range
     If Not Sh Is ActiveSheet Then Exit Sub
     If col Is Nothing Then Call hook
     With Application: .EnableEvents = False
         Set rg = col(Sh.Name)
         If .Average(rg) <> rg.Areas(1)(1, 1) Or rg.Count = 1 Then
             For Each rr In col
                 Sheets(rr.Parent.Name).Range(rr.Address).Value = IIf(.Min(rg) = .Median(rg), .Max(rg), .Min(rg))
             Next
         End If
     .EnableEvents = True: End With
End Sub