Option Explicit
Public WithEvents img As MSForms.Image
Public self As ClsImg

Private Declare Function OleCreatePictureIndirect Lib "oleaut32" (ByRef lpPictDesc As PicBmp, riid As GUID, ByVal fOwn As Long, ByRef lplpvObj As Any) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function CopyImage Lib "user32.dll" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long

Private Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(0 To 7) As Byte
End Type
Private Type PicBmp
  Size As Long
  Type As Long
  hBmp As Long
  hPal As Long
  Reserved As Long
End Type

Private Sub Class_Initialize()
    Set self = Me
End Sub

Private Sub img_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    PastePictureFromClipboard img
End Sub

Private Function GetPicture(ByVal hPic As Long, ByVal PicType As Long) As IPictureDisp
    Dim p As PicBmp, g As GUID
    With p
        .hBmp = hPic
        .Size = Len(p)
        .Type = PicType
    End With
    With g
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(3) = &HAA
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With
  OleCreatePictureIndirect p, g, 1, GetPicture
End Function

Private Sub PastePictureFromClipboard(ByRef img As Image)
    OpenClipboard 0
    If IsClipboardFormatAvailable(2) Then
        Set img.Picture = GetPicture(CopyImage(GetClipboardData(2), 0, 0, 0, 0), 1)
    End If
    CloseClipboard
End Sub

Public Sub init()
    Dim sh As Worksheet, obj As OLEObject, itm As ClsImg
    If Not col Is Nothing Then
        For Each itm In col
            Set itm.self = Nothing
        Next
    End If
    Set col = New Collection
    For Each sh In Sheets
    For Each obj In sh.OLEObjects
        If TypeOf obj.Object Is MSForms.Image Then
            Set itm = New ClsImg
            Set itm.img = obj.Object
            col.Add itm
        End If
    Next obj, sh
End Sub

Private WithEvents SpinBtn As MSForms.SpinButton
Private dVal#, dShift#, num As Byte
Public self As ClsSpinBtns
Public Property Set OleObj(obj As OLEObject)
    Set SpinBtn = obj.Object
    dVal = SpinBtn.Parent.Range(SpinBtn.LinkedCell).Value
    dShift = val(Replace(Replace(SpinBtn.Name, "*", "", InStr(SpinBtn.Name, "_") + 1), "_", "."))
    num = IIf(dShift \ 1 = dShift / 1, 0, Len(Trim(dShift)) - InStr(Trim(dShift), ","))
    Set self = Me
End Property
Private Sub SpinBtn_SpinUp()
    If dShift = 0 Then Exit Sub
    Application.EnableEvents = False
    With SpinBtn.Parent.Range(SpinBtn.LinkedCell)
        Dim v#: v = Round(dVal + dShift, num)
        .Value = IIf(v <= SpinBtn.Max, v, .Value)
        dVal = .Value
    End With
    Application.EnableEvents = True
End Sub
Private Sub SpinBtn_SpinDown()
    If dShift = 0 Then Exit Sub
    Application.EnableEvents = False
    With SpinBtn.Parent.Range(SpinBtn.LinkedCell)
        Dim v#: v = Round(dVal - dShift, num)
        .Value = IIf(v >= SpinBtn.Min, v, .Value)
        dVal = .Value
    End With
    Application.EnableEvents = True
End Sub

Public col As Collection
Public Sub init()
    If Not col Is Nothing Then
        For Each itm In col
            Set itm.self = Nothing
        Next
    End If
    Set col = New Collection
    Dim Sh As Worksheet, obj As OLEObject
    For Each Sh In Sheets
    For Each obj In Sh.OLEObjects
        If obj.progID = "Forms.SpinButton.1" Then
            With New ClsSpinBtns
                Set .OleObj = obj
                col.Add .self, Sh.Range(obj.LinkedCell).Address(, , , 1)
            End With
        End If
    Next obj, Sh
End Sub

Private Sub Workbook_Open()
    Call init
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim cell As Range
    On Error Resume Next
    For Each cell In Target
        If Not col(cell.Address(, , , 1)) Is Nothing Then Call init
    Next
End Sub