Event triggered when a shape is moved

DroppedWhere = ValidateDropZone(pt)
    If DroppedWhere <> "NONE" Then
        Select Case DroppedWhere
            Case "ZONE_0"
                'do something
            Case "ZONE_1"
                'do something else
            Case ...more zones
        End Select
    Else
        'drop did not intersect any zones
    End If

Option Explicit

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Const LOGPIXELSX As Long = 88
Private Const LOGPIXELSY As Long = 90

Private StopLoop As Boolean
Private ActiveControl As MSForms.Image
Private DpiX As Long, DpiY As Long
Private OffsetX As Long, OffsetY As Long
Private StartingPosX As Single, StartingPosY As Single
Private Zones(3) As RECT, hRect(3) As Long

Private Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    If Button = 1 Then
        Dim hdc As Long
        
        DefineDropZones
        hdc = GetDC(Application.hwnd)
        DpiX = GetDeviceCaps(hdc, LOGPIXELSX)
        DpiY = GetDeviceCaps(hdc, LOGPIXELSY)
        OffsetX = x
        OffsetY = y
        StartingPosX = Image1.Left
        StartingPosY = Image1.Top
        ReleaseDC Application.hwnd, hdc
        Application.Cursor = xlNorthwestArrow
        Set ActiveControl = Image1
        StopLoop = False
        StartLoop
    End If
End Sub

Private Sub Image1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    StopLoop = True
    Application.Cursor = xlDefault
End Sub

Private Sub StartLoop()
    Dim pt As POINTAPI, DroppedWhere As String
    
    Do Until StopLoop
        GetCursorPos pt
        pt = ScreenPixelsToWorkSheetPoints(pt)
        With ActiveControl
            .Left = pt.x
            .Top = pt.y
        End With
        DoEvents
    Loop
    
    DroppedWhere = ValidateDropZone(pt)
    'this is where you would call your code to respond
    'to the specific drop zone or the absense of a valid drop zone
    If DroppedWhere <> "NONE" Then
        Select Case DroppedWhere
            Case "ZONE_2"
                Set Image1.Picture = IPictureFromCopyPicture(Sheet2.Range("A3"))
                MsgBox "Dropped in " & DroppedWhere
            Case Else
                Set Image1.Picture = IPictureFromCopyPicture(Sheet2.Range("A1"))
                DoEvents
                MsgBox "Invalid Dropzone..."
                ActiveControl.Left = StartingPosX
                ActiveControl.Top = StartingPosY
            End Select
    Else
        'was not dropped in a valid drop zone
        'returned to original position on mouse up
        Set Image1.Picture = IPictureFromCopyPicture(Sheet2.Range("A1"))
        ActiveControl.Left = StartingPosX
        ActiveControl.Top = StartingPosY
    End If
    Set ActiveControl = Nothing
End Sub

Private Function ScreenPixelsToWorkSheetPoints(pt As POINTAPI) As POINTAPI
    pt.x = pt.x - ActiveWindow.PointsToScreenPixelsX(0)
    pt.y = pt.y - ActiveWindow.PointsToScreenPixelsY(0)
    pt.x = ((72 / DpiX) * pt.x) - OffsetX
    pt.y = ((72 / DpiY) * pt.y) - OffsetY
    ScreenPixelsToWorkSheetPoints = pt
End Function

'you cannot use ActiveWindow.RangeFromPoint here because
'the object returned will likely be the image control and not a range
'also see the RectInRegion Function
Private Function ValidateDropZone(pt As POINTAPI) As String
    Dim x As Integer, y As Integer, Corners(3) As POINTAPI
    
    'upper left
    Corners(0).x = ActiveControl.Left
    Corners(0).y = ActiveControl.Top
    'upper right
    Corners(1).x = Corners(0).x + ActiveControl.Width
    Corners(1).y = Corners(0).y
    'lower left
    Corners(2).x = Corners(0).x
    Corners(2).y = Corners(0).y + ActiveControl.Height
    'lower right
    Corners(3).x = Corners(1).x
    Corners(3).y = Corners(2).y
    
    ValidateDropZone = "NONE"
    For x = 0 To 3
        For y = 0 To 3
            If PtInRect(Zones(x), Corners(y).x, Corners(y).y) <> 0 Then
                ValidateDropZone = "ZONE_" & CStr(x)
                GoTo Intersected
            End If
        Next
    Next
    
Intersected:
    DeleteObject hRect(0)
    DeleteObject hRect(1)
    DeleteObject hRect(2)
    DeleteObject hRect(3)
End Function

Private Sub DefineDropZones()
    Dim x As Integer
    
    For x = 0 To 3
        With Range("ZONE_" & CStr(x))
            hRect(x) = SetRect(Zones(x), .Left, .Top, .Left + .Width, .Top + .Height)
        End With
    Next
End Sub

Option Explicit

Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function CopyImage Lib "user32" (ByVal hImage As Long, ByVal uType As Long, ByVal PixelWidth As Long, ByVal PixelHeight As Long, ByVal Flags As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (pPictDesc As PictDesc, riid As Guid, ByVal fOwn As Long, ppvObj As IPicture) As Long

Type Guid
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type
        
Type PictDesc
    cbSizeofStruct As Long
    picType As Long
    hImage As Long
    xExt As Long
    yExt As Long
End Type

Private Const CF_BITMAP = 2
Private Const S_OK As Long = &H0
Private Const LR_COPYRETURNORG = &H4

Function IPictureFromCopyPicture(Source As Object, Optional StretchWidth As Single, Optional StretchHeight As Single) As IPictureDisp
    Dim hBmp As Long
    Dim PictDesc As PictDesc
    Dim IDispatch As Guid
    Dim SaveWidth As Single
    Dim SaveHeight As Single
    Dim PicIsRng As Boolean
       
    If StretchWidth <> 0 Or StretchHeight <> 0 Then
        If TypeOf Source Is Range Then
            Source.CopyPicture
            ActiveSheet.PasteSpecial "Picture (Enhanced Metafile)"
            Set Source = Selection
            PicIsRng = True
        End If
        
        SaveWidth = Source.Width
        SaveHeight = Source.Height
        Source.Width = IIf(StretchWidth = 0, Source.Width, StretchWidth)
        Source.Height = IIf(StretchHeight = 0, Source.Height, StretchHeight)
        Source.CopyPicture xlScreen, xlBitmap
        
        If PicIsRng Then
            Source.Delete
        Else
            Source.Width = SaveWidth
            Source.Height = SaveHeight
        End If
    Else
        Source.CopyPicture xlScreen, xlBitmap
    End If

    If OpenClipboard(0) <> 0 Then
        hBmp = GetClipboardData(CF_BITMAP)
        hBmp = CopyImage(hBmp, 0, 0, 0, LR_COPYRETURNORG)
        CloseClipboard
        If hBmp <> 0 Then
                  
            With IDispatch
               .Data1 = &H20400
               .Data4(0) = &HC0
               .Data4(7) = &H46
            End With
            
            With PictDesc
               .cbSizeofStruct = Len(PictDesc)
               .picType = 1
               .hImage = hBmp
            End With
            
            If OleCreatePictureIndirect(PictDesc, IDispatch, False, IPictureFromCopyPicture) <> S_OK Then
                Set IPictureFromCopyPicture = Nothing
            End If
        End If
    End If
End Function