Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
8,062
Office Version
  1. 2016
Platform
  1. Windows
This little project took me hours and hours to complete but I think was worthy if only for the learning experience.

The project as such won't be of much use to most excel users but its shows that vba can do all kinds of neat things when combined with the win32 API.

This is what the code does:

* Allows moving and\or copying userform controls at runtime.
* The semi-transparent control that follows the mouse pointer during a dragging operation is actually a win32 static control (This static control, not being a child window of the userform, was the most tricky part to make it a layered window and to keep it confined within the bounderies of the parent form.)
* A colored dashed frame is drawn around the static control.
* The cursor changes dynamically depending on moving the controls , copying them (Holding CTRL key down) or when -the image is being moved outside the parent form. (custom cursor not showing on the Gif below but works as expected in the file demo below)
* Right-click context menu for deleting the controls.
* A label control can optionally be integrated into the class for displaying the current user activity.

This is the signature of only Class Method that hooks the UserForm controls:

Public Sub HookControl( _
ByVal ThisClassInstance As cls_DraggableControl, _
ByVal Ctrl As Control, _
Optional ByVal UILabel As Control _
)

Note: The transparency of the static control won't work unless the Desktop Window Manager (DWM) is enabled in the machine running the code.

Workbook Demo










1- Class code (Cls_DraggableControl):
VBA Code:
Option Explicit

Private Enum eCursor
    Drag_Cursor = 0
    Copy_Cursor = 1
    No_Cursor = 2
End Enum

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 Type uPicDesc
    Size As Long
    Type As Long
    #If Win64 Then
        hPic As LongLong
        hPal As LongLong
#Else
       hPic As Long
       hPal As Long
  #End If
End Type

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Private Type LOGPEN
    lopnStyle As Long
    lopnWidth As POINTAPI
    lopnColor As Long
End Type

Private Type LOGBRUSH
    lbStyle As Long
    lbColor As Long
     #If Win64 Then
        lbHatch As LongLong
    #Else
        lbHatch As Long
    #End If
End Type

Private Type GdiplusStartupInput
   GdiplusVersion As Long
  #If Win64 Then
        DebugEventCallback As LongLong
        SuppressBackgroundThread As LongLong
  #Else
        DebugEventCallback As Long
        SuppressBackgroundThread As Long
  #End If
   SuppressExternalCodecs As Long
End Type

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal Point As LongPtr) As LongLong
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongLong, ByVal nIndex As Long, ByVal dwNewLong As LongLong) As LongLong
    #Else
        Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As LongPtr
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPtr
    #End If
    
    Private Declare PtrSafe Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As LongPtr, ByVal hMenu As LongPtr, ByVal hInstance As LongPtr, lpParam As Any) As LongPtr
    Private Declare PtrSafe Function DestroyWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As LongPtr, ByVal crey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As LongPtr
    Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function CopyImage Lib "user32" (ByVal handle As LongPtr, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As LongPtr
    Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    Private Declare PtrSafe Function ScreenToClient Lib "user32" (ByVal hwnd As LongPtr, lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
    Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function IsChild Lib "user32" (ByVal hWndParent As LongPtr, ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function DestroyIcon Lib "user32" (ByVal hIcon As LongPtr) As Long
    Private Declare PtrSafe Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As LongPtr
    Private Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hdc As LongPtr, ByVal hObject As LongPtr) As LongPtr
    Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
    Private Declare PtrSafe Function SetActiveWindow Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr
    Private Declare PtrSafe Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As LongPtr
    Private Declare PtrSafe Function SetWindowRgn Lib "user32" (ByVal hwnd As LongPtr, ByVal hRgn As LongPtr, ByVal bRedraw As Long) As Long
    Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Private Declare PtrSafe Function IntersectRect Lib "user32" (lpDestRect As RECT, lpSrc1Rect As RECT, lpSrc2Rect As RECT) As Long
    Private Declare PtrSafe Function IsRectEmpty Lib "user32" (lpRect As RECT) As Long
    Private Declare PtrSafe Function DwmGetWindowAttribute Lib "Dwmapi.dll" (ByVal hwnd As LongPtr, ByVal dwAttribute As Long, ByRef pvAttribute As Any, ByVal cbAttribute As Long) As Long
    Private Declare PtrSafe Function ExtCreatePen Lib "gdi32" (ByVal dwPenStyle As Long, ByVal dwWidth As Long, lplb As LOGBRUSH, ByVal dwStyleCount As Long, lpStyle As Long) As LongPtr
    Private Declare PtrSafe Function Rectangle Lib "gdi32" (ByVal hdc As LongPtr, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Private Declare PtrSafe Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As LongPtr
    Private Declare PtrSafe Function CreateIconFromResourceEx Lib "user32.dll" (ByRef presbits As Any, ByVal dwResSize As Long, ByVal fIcon As Long, ByVal dwVer As Long, ByVal cxDesired As Long, ByVal cyDesired As Long, ByVal Flags As Long) As LongPtr
    Private Declare PtrSafe Function SetCursorAPI Lib "user32" Alias "SetCursor" (ByVal hCursor As LongPtr) As LongPtr
    Private Declare PtrSafe Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As LongPtr, ByVal lpCursorName As Long) As Long
    Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleAut32.dll" (PicDesc As uPicDesc, RefIID As Any, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare PtrSafe Function CreatePopupMenu Lib "user32" () As LongPtr
    Private Declare PtrSafe Function DestroyMenu Lib "user32" (ByVal hMenu As LongPtr) As Long
    Private Declare PtrSafe Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As LongPtr, ByVal wFlags As Long, ByVal wIDNewItem As LongPtr, ByVal lpNewItem As Any) As Long
    Private Declare PtrSafe Function TrackPopupMenuEx Lib "user32" (ByVal hMenu As LongPtr, ByVal un As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal hwnd As LongPtr, ByVal lpTPMParams As Long) As Long
    Private Declare PtrSafe Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As LongPtr, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As LongPtr, ByVal hBitmapChecked As LongPtr) As Long
    Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr
    'GDI+
    Private Declare PtrSafe Function GdiplusStartup Lib "gdiplus" (token As LongPtr, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
    Private Declare PtrSafe Function GdiplusShutdown Lib "gdiplus" (ByVal token As LongPtr) As Long
    Private Declare PtrSafe Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" (ByVal hbm As LongPtr, ByVal hPal As LongPtr, BITMAP As LongPtr) As Long
    Private Declare PtrSafe Function GdipDisposeImage Lib "gdiplus" (ByVal Image As LongPtr) As LongPtr
    Private Declare PtrSafe Function GdipCreateHBITMAPFromBitmap Lib "gdiplus" (ByVal BITMAP As LongPtr, hbmReturn As LongPtr, ByVal background As Long) As Long
    Private Declare PtrSafe Function GdipGetImageThumbnail Lib "gdiplus" (ByVal Image As LongPtr, ByVal thumbWidth As Long, ByVal thumbHeight As Long, thumbImage As LongPtr, ByVal Callback As LongPtr, ByVal callbackData As LongPtr) As Long

    Private hBitmap As LongPtr, hCopy As LongPtr

#Else

    Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
    Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare Function CopyImage Lib "user32" (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 GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) 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 IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hwnd As Long) As Long
    Private Declare Function IsChild Lib "user32" (ByVal hWndParent As Long, ByVal hwnd As Long) 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 GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
    Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
    Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Private Declare Function SetActiveWindow Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
    Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
    Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Private Declare Function IntersectRect Lib "user32" (lpDestRect As RECT, lpSrc1Rect As RECT, lpSrc2Rect As RECT) As Long
    Private Declare Function IsRectEmpty Lib "user32" (lpRect As RECT) As Long
    Private Declare Function DwmGetWindowAttribute Lib "Dwmapi.dll" (ByVal hwnd As Long, ByVal dwAttribute As Long, ByRef pvAttribute As Any, ByVal cbAttribute As Long) As Long
    Private Declare Function ExtCreatePen Lib "gdi32" (ByVal dwPenStyle As Long, ByVal dwWidth As Long, lplb As LOGBRUSH, ByVal dwStyleCount As Long, lpStyle As Long) As Long
    Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
    Private Declare Function CreateIconFromResourceEx Lib "User32.dll" (ByRef presbits As Any, ByVal dwResSize As Long, ByVal fIcon As Long, ByVal dwVer As Long, ByVal cxDesired As Long, ByVal cyDesired As Long, ByVal Flags As Long) As Long
    Private Declare Function SetCursorAPI Lib "user32" Alias "SetCursor" (ByVal hCursor As Long) As Long
    Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
    Private Declare Function OleCreatePictureIndirect Lib "oleAut32.dll" (PicDesc As uPicDesc, RefIID As Any, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare Function CreatePopupMenu Lib "user32" () As Long
    Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
    Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
    Private Declare Function TrackPopupMenuEx Lib "user32" (ByVal hMenu As Long, ByVal un As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal hwnd As Long, ByVal lpTPMParams As Long) As Long
    Private Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function CloseClipboard Lib "user32" () As Long
    Private Declare Function EmptyClipboard Lib "user32" () As Long
    Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
    'GDI+
    Private Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
    Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Long
    Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" (ByVal hbm As Long, ByVal hPal As Long, BITMAP As Long) As Long
    Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As Long
    Private Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus" (ByVal BITMAP As Long, hbmReturn As Long, ByVal background As Long) As Long
    Private Declare Function GdipGetImageThumbnail Lib "gdiplus" (ByVal Image As Long, ByVal thumbWidth As Long, ByVal thumbHeight As Long, thumbImage As Long, ByVal Callback As Long, ByVal callbackData As Long) As Long

    Private hBitmap As Long, hCopy As Long

#End If


Private bMouseDragging As Boolean
Private oNewClass As cls_DraggableControl
Private oThisInstance As cls_DraggableControl
Private oContainers As Collection
Private lCtrlWidth As Long, lCtrlHeight As Long
Private oUILabel As Control

Private WithEvents Cntrl As MSForms.Image



'___________________________________Class Public Method________________________________________________

Public Sub HookControl(ByVal ThisClassInstance As cls_DraggableControl, ByVal Ctrl As Control, Optional ByVal UILabel As Control)

    Const CHILDID_SELF = &H0&
    
    #If Win64 Then
        Dim hwnd As LongLong
    #Else
        Dim hwnd As Long
    #End If
    
    Dim oForm As Object
    Dim oCtrl As Control
    
    Set oThisInstance = ThisClassInstance
    
    Set oForm = GetUserFormObject(Ctrl)
    
    If oContainers Is Nothing Then
        Set oContainers = New Collection
        IUnknown_GetWindow oForm, VarPtr(hwnd)
        oContainers.Add oForm, CStr(GetNextWindow(hwnd, 5))
        For Each oCtrl In oForm.Controls
            If TypeOf oCtrl Is MSForms.Frame Then
                oContainers.Add oCtrl, CStr(oCtrl.[_GethWnd])
            End If
        Next oCtrl
    End If
    Set Cntrl = Ctrl
    
    If Not UILabel Is Nothing Then
        Set oUILabel = UILabel
    End If

End Sub



'___________________________________Class Private Routines________________________________________________


Private Sub Cntrl_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    If Button = 2 Then
        Call CreateAndShowContextMenu
    End If

End Sub

Private Sub Cntrl_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    If Button = 1 And bMouseDragging = False Then
        Call DragControl(CreateWindow(Cntrl), Cntrl, X, Y)
    End If

End Sub


#If Win64 Then
    Private Function CreateWindow( _
            ByVal Cntrl As Control _
            ) As LongLong

#Else
        Private Function CreateWindow( _
            ByVal Cntrl As Control _
            ) As Long
#End If

    Const WS_POPUP = &H80000000
    Const SS_BITMAP = &HE
    Const IMAGE_BITMAP = &H0
    Const STM_SETIMAGE = &H172
    Const WS_EX_TOPMOST = &H8
    Const WS_EX_LAYERED = &H80000
    Const WS_EX_NOACTIVATE = &H8000000
    Const GWL_HWNDPARENT = (-8)
    Const GW_CHILD = &H5
    Const LWA_ALPHA = &H2&    

    #If Win64 Then
        Dim hForm As LongPtr, hStatic As LongPtr
    #Else
        Dim hForm As Long, hStatic As Long
    #End If
    
    lCtrlWidth = PTtoPX(Cntrl.Width, False)
    lCtrlHeight = PTtoPX(Cntrl.Height, True)
    hStatic = CreateWindowEx(WS_EX_LAYERED + WS_EX_NOACTIVATE + WS_EX_TOPMOST, _
    "STATIC", "", WS_POPUP Or SS_BITMAP, 0, 0, _
    0, 0, 0, 0&, GetModuleHandle(vbNullString), 0&)
    Call SetLayeredWindowAttributes(hStatic, 0, 100, LWA_ALPHA)
    Call IUnknown_GetWindow(GetUserFormObject(Cntrl), VarPtr(hForm))
    Call SetWindowLong(hStatic, GWL_HWNDPARENT, hForm)
    hBitmap = CreateAndResizeBitmap(Cntrl.Picture, lCtrlWidth, lCtrlHeight)
    Call SendMessage(hStatic, STM_SETIMAGE, IMAGE_BITMAP, ByVal hBitmap)
    Call SetActiveWindow(hForm)
    
    CreateWindow = hStatic

End Function


#If Win64 Then
    Private Sub DragControl( _
        ByVal hStatic As LongLong, _
        ByVal Ctrl As Control, _
        ByVal X As Single, _
        ByVal Y As Single _
        )
        
        Dim hStaticRgn As LongLong, hStaticDC As LongLong, hContainer As LongLong
#Else
    Private Sub DragControl( _
        ByVal hStatic As Long, _
        ByVal Ctrl As Control, _
        ByVal X As Single, _
        ByVal Y As Single _
        )
        
        Dim hStaticRgn As Long, hStaticDC As Long, hContainer As Long
 #End If

    Const SWP_SHOWWINDOW = &H40
    Const SWP_NOACTIVATE = &H10
    Const CHILDID_SELF = &H0&
    
    Dim oContainer As Object, lIndex As Long
    Dim tDstRect As RECT, tPt1 As POINTAPI, tPt2 As POINTAPI
    Dim tFormRect As RECT, tStaticRect As RECT, tCursPos As POINTAPI

    Do While GetAsyncKeyState(vbKeyLButton)
    
        bMouseDragging = True
        
        tFormRect = Get_Form_Extended_Frame_Bounds_Rectangle(GetUserFormObject(Ctrl))
        Call GetWindowRect(hStatic, tStaticRect)
        
        Call IntersectRect(tDstRect, tFormRect, tStaticRect)
        
        With tDstRect
            tPt1.X = .Left
            tPt1.Y = .Top
            tPt2.X = .Right
            tPt2.Y = .Bottom
        End With
        
        Call ScreenToClient(hStatic, tPt1)
        Call ScreenToClient(hStatic, tPt2)
        
        hStaticRgn = CreateRectRgn(tPt1.X, tPt1.Y, tPt2.X, tPt2.Y)
        hStaticDC = GetDC(hStatic)
        Call MakeStaticBorder(hStaticDC)
        Call SetWindowRgn(hStatic, hStaticRgn, True)
        Call ReleaseDC(hStatic, hStaticDC)
        ' Call DeleteObject(hStaticRgn)  ' !!

        Call GetCursorPos(tCursPos)
        Call SetWindowPos( _
            hStatic, 0, tCursPos.X - PTtoPX(X, False), tCursPos.Y - PTtoPX(Y, True), _
            lCtrlWidth, lCtrlHeight, SWP_NOACTIVATE + SWP_SHOWWINDOW)

        #If Win64 Then
            Dim lPT As LongLong
            Call CopyMemory(lPT, tCursPos, LenB(lPT))
            hContainer = WindowFromPoint(lPT)
        #Else
            hContainer = WindowFromPoint(tCursPos.X, tCursPos.Y)
        #End If
                
        For lIndex = 1 To oContainers.Count
            On Error Resume Next
                Set oContainer = oContainers(CStr(hContainer))
            On Error GoTo 0
            If Not oContainer Is Nothing Then
                Exit For
            End If
        Next lIndex
    
        If IsRectEmpty(tDstRect) Then
                SetCursor = No_Cursor
                If Not oUILabel Is Nothing Then
                    oUILabel.Caption = "Outside UserForm."
                End If
        Else
            If GetAsyncKeyState(VBA.vbKeyControl) Then
                SetCursor = Copy_Cursor
                If Not oUILabel Is Nothing Then
                    oUILabel.Caption = "Copying Control."
                End If
            Else
                SetCursor = Drag_Cursor
                If Not oUILabel Is Nothing Then
                    oUILabel.Caption = "Moving Control."
                End If
            End If
        End If

        DoEvents
        
    Loop
    
    bMouseDragging = False
    
    Call DeleteObject(hCopy)
    Call DeleteObject(hBitmap)

    If IsRectEmpty(tDstRect) = 0 Then
        Call RelocateControl(Ctrl, hStatic, oContainer)
        Call DestroyWindow(hStatic)
    End If

End Sub


#If Win64 Then
    Private Sub RelocateControl( _
        ByVal Ctrl As Control, _
        ByVal StaticHwnd As LongLong, _
        ByVal Container As Object _
        )

        Dim hContainer As LongLong, hForm As LongLong
#Else

    Private Sub RelocateControl( _
        ByVal Ctrl As Control, _
        ByVal StaticHwnd As Long, _
        ByVal Container As Object _
       )
        
        Dim hContainer As Long, hForm As Long
#End If

    Const WM_SETREDRAW = &HB
    Const SM_CYCAPTION = 4
    Const SM_CYDLGFRAME = 8
    Const SM_CYBORDER = 6
    Const SM_CXEDGE = 45
    Const SM_CYEDGE = 46
    Const SM_CYFRAME = 33

    Dim oNewControl   As Control
    Dim lFrameHOffset As Long, lFrameVOffset As Long
    Dim tStaticRect As RECT, tCursPos As POINTAPI

    On Error GoTo xit
    
    Call IUnknown_GetWindow(Container, VarPtr(hContainer))
    Call IUnknown_GetWindow(GetUserFormObject(Ctrl), VarPtr(hForm))
    
    Call SendMessage(hContainer, ByVal WM_SETREDRAW, ByVal 0, 0)
    
    Select Case GetAsyncKeyState(VBA.vbKeyControl)
        Case 0  'moving.
            If Cntrl.Parent Is Container Then
                Set oNewControl = Cntrl
                If Not oUILabel Is Nothing Then
                    oUILabel.Caption = Ctrl.Name & " moved."
                End If
            Else
                Cntrl.Visible = False
                Set oNewControl = AddNewControl(Container)
                oNewControl.Name = Cntrl.Name
                If Not oUILabel Is Nothing Then
                   oUILabel.Caption = Ctrl.Name & " moved."
                End If
            End If
        Case Else 'copying.
            Set oNewControl = AddNewControl(Container)
            If Not oUILabel Is Nothing Then
                oUILabel.Caption = Ctrl.Name & " copied."
            End If
    End Select
    
    lFrameHOffset = GetSystemMetrics(SM_CXEDGE)
    lFrameVOffset = GetSystemMetrics(SM_CYEDGE) + _
    GetSystemMetrics(SM_CYFRAME) + GetSystemMetrics(SM_CYBORDER)
    Call GetWindowRect(StaticHwnd, tStaticRect)
    Call GetCursorPos(tCursPos)
    tCursPos.X = tStaticRect.Left: tCursPos.Y = tStaticRect.Top
    Call ScreenToClient(hContainer, tCursPos)
    
    With oNewControl
        .Left = PXtoPT(tCursPos.X - IIf(IsChild(hForm, hContainer), lFrameHOffset, 0), False)
        .Top = PXtoPT(tCursPos.Y - IIf(IsChild(hForm, hContainer), lFrameVOffset, 0), True)
        .Width = Cntrl.Width
        .Height = Cntrl.Height
        .PictureSizeMode = fmPictureSizeModeStretch
        .Picture = Cntrl.Picture
    End With
    
xit:
    Call SendMessage(hContainer, ByVal WM_SETREDRAW, ByVal 1, 0)
    Container.Repaint

End Sub


Private Function AddNewControl(ByVal Container As Object, Optional ByVal UILabel As Control) As Control

        Dim oNewCtrl As Control

        Set AddNewControl = Container.Controls.Add("Forms.Image.1")
        Set oNewClass = New cls_DraggableControl
        oNewClass.HookControl oNewClass, AddNewControl, oUILabel

End Function


#If Win64 Then
    Private Sub MakeStaticBorder( _
        ByVal hdc As LongLong _
    )
        Dim hPrevBrush As LongLong, hBrush As LongLong, hPrevPen As LongLong, hPen As LongLong
#Else
    Private Sub MakeStaticBorder( _
        ByVal hdc As Long _
    )
       Dim hPrevBrush As Long, hBrush As Long, hPrevPen As Long, hPen As Long
#End If

    Const DASH_LEN = 5
    Const SPACE_LEN = 10
    Const PEN_WIDTH = 4
    Const HOLLOW_BRUSH = 5
    Const PEN_COLOR = vbRed
    Const BS_SOLID = 0
    Const PS_GEOMETRIC = &H10000
    Const PS_USERSTYLE = 7&

    Dim LOGBRUSH As LOGBRUSH
    Dim lStyleArray(1) As Long
  
    With LOGBRUSH
        .lbStyle = BS_SOLID
        .lbColor = PEN_COLOR
    End With
    
    lStyleArray(0) = DASH_LEN
    lStyleArray(1) = SPACE_LEN
    hPen = ExtCreatePen(PS_GEOMETRIC Or PS_USERSTYLE, PEN_WIDTH, LOGBRUSH, 2, lStyleArray(0))
    hBrush = GetStockObject(HOLLOW_BRUSH)
    hPrevBrush = SelectObject(hdc, hBrush)
    hPrevPen = SelectObject(hdc, hPen)
    Call Rectangle(hdc, 0, 0, lCtrlWidth, lCtrlHeight)
    Call SelectObject(hdc, hPrevPen)
    Call SelectObject(hdc, hPrevBrush)
    Call DeleteObject(hPen)
    Call DeleteObject(hBrush)

End Sub


Private Sub CreateAndShowContextMenu()

    Const MF_STRING = &H0&
    Const MF_BYPOSITION = &H400
    Const TPM_RETURNCMD = &H100&
    
    #If Win64 Then
        Dim hMenu As LongLong, hwnd As LongLong
    #Else
        Dim hMenu As Long, hwnd As Long
    #End If
    
    Dim lShowPopupMenu As Long
    Dim oFaceIdPic As StdPicture, tCursPos As POINTAPI
    
    hMenu = CreatePopupMenu()
    
    If hMenu Then
        Call AppendMenu(hMenu, MF_STRING, 1, "&Remove")
        Set oFaceIdPic = PicFromFaceID(478)
        If Not oFaceIdPic Is Nothing Then
            Call SetMenuItemBitmaps(hMenu, 0, MF_BYPOSITION, oFaceIdPic, oFaceIdPic)
        End If
        Call IUnknown_GetWindow(GetUserFormObject(Cntrl), VarPtr(hwnd))
        Call GetCursorPos(tCursPos)
        lShowPopupMenu = TrackPopupMenuEx(hMenu, TPM_RETURNCMD, tCursPos.X, tCursPos.Y, hwnd, ByVal 0&)
        If lShowPopupMenu = 1 Then Cntrl.Visible = False
        Call DestroyMenu(hMenu)
        If Not oUILabel Is Nothing Then
            oUILabel.Caption = Cntrl.Name & " Deleted."
        End If
    End If

End Sub


Private Function ScreenDPI(ByVal bVert As Boolean) As Long

    #If Win64 Then
        Dim hdc As LongLong
    #Else
        Dim hdc As Long
    #End If

    Const LOGPIXELSX As Long = 88
    Const LOGPIXELSY As Long = 90
    Static lDPI(1) As Long

    If lDPI(0) = 0 Then
        hdc = GetDC(0)
        lDPI(0) = GetDeviceCaps(hdc, LOGPIXELSX)
        lDPI(1) = GetDeviceCaps(hdc, LOGPIXELSY)
        ReleaseDC 0, hdc
    End If
    
    ScreenDPI = lDPI(Abs(bVert))

End Function


Private Function PTtoPX(ByVal Points As Single, ByVal bVert As Boolean) As Long
    Const POINTSPERINCH As Long = 72
    PTtoPX = Points * ScreenDPI(bVert) / POINTSPERINCH
End Function


Private Function PXtoPT(ByVal Pixels As Long, ByVal bVert As Boolean) As Long
    Const POINTSPERINCH As Long = 72
    PXtoPT = Pixels / (ScreenDPI(bVert) / POINTSPERINCH)
End Function


Private Function GetUserFormObject(ByVal Ctrl As Control) As Object

    Dim oTemp As Object
    
    Set oTemp = Ctrl.Parent
    Do While TypeOf oTemp Is MSForms.Control
        Set oTemp = oTemp.Parent
        DoEvents
    Loop
    Set GetUserFormObject = oTemp
 
End Function


Private Function PicFromFaceID(ByVal FaceID As Long) As IPicture

    #If Win64 Then
        Dim hPtr As LongLong
    #Else
        Dim hPtr As Long
    #End If
    
    Const S_OK = &H0
    Const CF_BITMAP = 2
    Const IMAGE_BITMAP = 0
    Const LR_COPYRETURNORG = &H4
    Const PICTYPE_BITMAP = 1

    Dim iPic As IPicture
    Dim IID_IDispatch As GUID, uPicinfo As uPicDesc

    On Error GoTo errHandler
            
    Application.CommandBars.FindControl(id:=FaceID).CopyFace
    
    Call OpenClipboard(0)
    hPtr = GetClipboardData(CF_BITMAP)
  
    If hPtr Then
        hPtr = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
        Call EmptyClipboard
        Call CloseClipboard
        
        With IID_IDispatch
            .Data1 = &H20400
            .Data4(0) = &HC0
            .Data4(7) = &H46
        End With
        With uPicinfo
            .Size = Len(uPicinfo)
            .Type = PICTYPE_BITMAP
            .hPic = hPtr
            .hPal = 0
        End With
        
        If OleCreatePictureIndirect(uPicinfo, IID_IDispatch, True, iPic) = S_OK Then
            Set PicFromFaceID = iPic
        End If
    End If
    
    Exit Function
    
errHandler:
    
    Call EmptyClipboard
    Call CloseClipboard
    
End Function


Private Function Get_Form_Extended_Frame_Bounds_Rectangle(ByVal Form As Object) As RECT

    Const SM_CYCAPTION = 4
    Const SM_CYDLGFRAME = 8
    Const SM_CYBORDER = 6
    Const SM_CXEDGE = 45
    Const SM_CYEDGE = 46
    Const SM_CYFRAME = 33
    Const DWMWA_EXTENDED_FRAME_BOUNDS = 9

    #If Win64 Then
        Dim hForm As LongLong
    #Else
        Dim hForm As Long
    #End If

    Dim tRect As RECT, tFormRect As RECT

    Call IUnknown_GetWindow(Form, VarPtr(hForm))
    Call DwmGetWindowAttribute(hForm, DWMWA_EXTENDED_FRAME_BOUNDS, tFormRect, LenB(tFormRect))
    Call GetWindowRect(hForm, tRect)
    
    If tFormRect.Right = 0 Then
        With tRect
            .Top = .Top + GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYDLGFRAME)
        End With
        tFormRect = tRect
    Else
        With tFormRect
            .Top = .Top + GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYDLGFRAME) _
            + GetSystemMetrics(SM_CYFRAME) + GetSystemMetrics(SM_CYBORDER)
        End With
    End If
    
    Get_Form_Extended_Frame_Bounds_Rectangle = tFormRect

End Function


#If Win64 Then
    Private Function BuildDrag_Cursor() As LongLong
#Else
    Private Function BuildDrag_Cursor() As Long
#End If

    ReDim longs(0 To 186) As Long

    longs(0) = 0: longs(1) = 40: longs(2) = 32: longs(3) = 64: longs(4) = 262145: longs(5) = 0: longs(6) = 640: longs(7) = 0: longs(8) = 0: longs(9) = 16: longs(10) = 0: longs(11) = 0: longs(12) = 8388608: longs(13) = 32768: longs(14) = 8421376: longs(15) = 128: longs(16) = 8388736: longs(17) = 32896: longs(18) = 12632256: longs(19) = 8421504: longs(20) = 16711680: longs(21) = 65280: longs(22) = 16776960: longs(23) = 255: longs(24) = 16711935: longs(25) = 65535: longs(26) = 16777215: longs(27) = 0: longs(28) = 0: longs(29) = 0
    longs(30) = 0: longs(31) = 0: longs(32) = 0: longs(33) = 0: longs(34) = 0: longs(35) = 0: longs(36) = 151587072: longs(37) = 151587081: longs(38) = 9: longs(39) = 0: longs(40) = -1869611008: longs(41) = -1869574000: longs(42) = 144: longs(43) = 0: longs(44) = 2304: longs(45) = 0: longs(46) = 9: longs(47) = 0: longs(48) = 9437184: longs(49) = 0: longs(50) = 144: longs(51) = 0: longs(52) = 2304: longs(53) = 0: longs(54) = 9: longs(55) = 0: longs(56) = 9437184: longs(57) = 0: longs(58) = 144: longs(59) = 0
    longs(60) = 2304: longs(61) = 0: longs(62) = 9: longs(63) = 0: longs(64) = 9437184: longs(65) = 0: longs(66) = 144: longs(67) = 0: longs(68) = 2304: longs(69) = 0: longs(70) = 9: longs(71) = 0: longs(72) = -1869611008: longs(73) = -1869574000: longs(74) = 144: longs(75) = 0: longs(76) = 151587072: longs(77) = 151587081: longs(78) = 9: longs(79) = 150994944: longs(80) = 144: longs(81) = 0: longs(82) = 0: longs(83) = -1728053248: longs(84) = 153: longs(85) = 0: longs(86) = 0: longs(87) = -1728053248: longs(88) = 153: longs(89) = 0
    longs(90) = 0: longs(91) = -1727463424: longs(92) = 144: longs(93) = 0: longs(94) = 0: longs(95) = -1727463280: longs(96) = 144: longs(97) = 0: longs(98) = 0: longs(99) = -1718026087: longs(100) = 0: longs(101) = 0: longs(102) = 0: longs(103) = -1717989223: longs(104) = 0: longs(105) = 0: longs(106) = 0: longs(107) = -1868981863: longs(108) = 0: longs(109) = 0: longs(110) = 0: longs(111) = -1717986919: longs(112) = 37017: longs(113) = 0: longs(114) = 0: longs(115) = -1717986919: longs(116) = 153: longs(117) = 0: longs(118) = 0: longs(119) = -1717986919
    longs(120) = 144: longs(121) = 0: longs(122) = 0: longs(123) = -1717986919: longs(124) = 0: longs(125) = 0: longs(126) = 0: longs(127) = -1868981863: longs(128) = 0: longs(129) = 0: longs(130) = 0: longs(131) = 10066329: longs(132) = 0: longs(133) = 0: longs(134) = 0: longs(135) = 9476505: longs(136) = 0: longs(137) = 0: longs(138) = 0: longs(139) = 39321: longs(140) = 0: longs(141) = 0: longs(142) = 0: longs(143) = 37017: longs(144) = 0: longs(145) = 0: longs(146) = 0: longs(147) = 153: longs(148) = 0: longs(149) = 0
    longs(150) = 0: longs(151) = 144: longs(152) = 0: longs(153) = 0: longs(154) = 0: longs(155) = -1: longs(156) = -1: longs(157) = -1079317761: longs(158) = 2136339967: longs(159) = -1073745921: longs(160) = 2147481599: longs(161) = -1073745921: longs(162) = 2147481599: longs(163) = -1073745921: longs(164) = 2147481599: longs(165) = -1073745921: longs(166) = 2136339967: longs(167) = -1079317761: longs(168) = -32770: longs(169) = -49156: longs(170) = -49156: longs(171) = -32776: longs(172) = -32904: longs(173) = -208: longs(174) = -240: longs(175) = -255: longs(176) = -57600: longs(177) = -49408: longs(178) = -33024: longs(179) = -256
    longs(180) = -255: longs(181) = -253: longs(182) = -249: longs(183) = -241: longs(184) = -225: longs(185) = -193: longs(186) = -129:

    BuildDrag_Cursor = CreateIconFromResourceEx(longs(0), UBound(longs) * 4 + 4, 0&, &H30000, 0, 0, 0&)

End Function


#If Win64 Then
    Private Function BuildCopy_Cursor() As LongLong
#Else
    Private Function BuildCopy_Cursor() As Long
#End If

    ReDim longs(0 To 186) As Long
    
    longs(1) = 40: longs(2) = 32: longs(3) = 64: longs(4) = 262145: longs(6) = 640: longs(9) = 16: longs(10) = 16: longs(12) = 8388608: longs(13) = 32768: longs(14) = 8421376: longs(15) = 128: longs(16) = 8388736: longs(17) = 32896: longs(18) = 8421504: longs(19) = 12632256: longs(20) = 16711680: longs(21) = 65280: longs(22) = 16776960: longs(23) = 255: longs(24) = 16711935: longs(25) = 65535: longs(26) = 16777215:
    longs(36) = 151587072: longs(37) = 151587081: longs(38) = 9: longs(40) = -1869611008: longs(41) = -1869574000: longs(42) = 144: longs(44) = 2304: longs(46) = 9: longs(48) = 9437184: longs(50) = 144: longs(52) = 2304: longs(54) = 9: longs(56) = 9437184: longs(58) = 144:
    longs(60) = 2304: longs(62) = 9: longs(64) = 9437184: longs(66) = 144: longs(68) = 2304: longs(70) = 9: longs(72) = -1869611008: longs(73) = -1869574000: longs(74) = 144: longs(76) = 151587072: longs(77) = 151587081: longs(78) = 9: longs(79) = 150994944: longs(80) = 144: longs(83) = -1728053248: longs(84) = 153: longs(87) = -1728053248: longs(88) = 153: longs(89) = 37017
    longs(91) = -1727463424: longs(92) = 144: longs(93) = 37017: longs(95) = -1727463280: longs(96) = 144: longs(97) = 37017: longs(99) = -1718026087: longs(100) = -1861681152: longs(101) = 10064281: longs(103) = -1717989223: longs(104) = -1727463424: longs(105) = 10066329: longs(107) = -1868981863: longs(108) = -1727463424: longs(109) = 10066321: longs(111) = -1717986919: longs(112) = 37017: longs(113) = 37017: longs(115) = -1717986919: longs(116) = 153: longs(117) = 37017: longs(119) = -1717986919
    longs(120) = 144: longs(121) = 37017: longs(123) = -1717986919: longs(127) = -1868981863: longs(131) = 10066329: longs(135) = 9476505: longs(139) = 39321: longs(143) = 37017: longs(147) = 153:
    longs(151) = 144: longs(155) = -1: longs(156) = -1: longs(157) = -1079317761: longs(158) = 2136339967: longs(159) = -1073745921: longs(160) = 2147481599: longs(161) = -1073745921: longs(162) = 2147481599: longs(163) = -1073745921: longs(164) = 2147481599: longs(165) = -1073745921: longs(166) = 2136339967: longs(167) = -1079317761: longs(168) = -32770: longs(169) = -49156: longs(170) = -14729220: longs(171) = -14712840: longs(172) = -14712968: longs(173) = -16517072: longs(174) = -16517104: longs(175) = -16517119: longs(176) = -14737664: longs(177) = -14729472: longs(178) = -14713088: longs(179) = -256
    longs(180) = -255: longs(181) = -253: longs(182) = -249: longs(183) = -241: longs(184) = -225: longs(185) = -193: longs(186) = -129:
    
    BuildCopy_Cursor = CreateIconFromResourceEx(longs(0), UBound(longs) * 4 + 4, 0&, &H30000, 0, 0, 0&)

End Function


Private Property Let SetCursor(Cur As eCursor)

    Const IDC_NO = 32648&
    
    #If Win64 Then
        Dim hCursor As LongLong
    #Else
        Dim hCursor As Long
    #End If
    
    Select Case Cur
        Case Drag_Cursor
            hCursor = BuildDrag_Cursor
        Case Copy_Cursor
            hCursor = BuildCopy_Cursor
        Case No_Cursor
            hCursor = LoadCursor(0, IDC_NO)
    End Select
    
    Call SetCursorAPI(hCursor)
    Call DestroyIcon(hCursor)

End Property

#If Win64 Then
    Private Function CreateAndResizeBitmap( _
    ByVal Image As StdPicture, _
    ByVal Width As Long, _
    ByVal Height As Long _
    ) As LongLong

    Dim lGDIP As LongLong, lBitmap As LongLong, lThumb As LongLong, hBitmap As LongLong
    
#Else
    Private Function CreateAndResizeBitmap( _
    ByVal Image As StdPicture, _
    ByVal Width As Long, _
    ByVal Height As Long _
    ) As Long

    Dim lGDIP As Long, lBitmap As Long, lThumb As Long, hBitmap As Long
    
  #End If
 
    Const S_OK = 0&
    
    Dim CreatheThumbnail As StdPicture
    Dim tSI As GdiplusStartupInput
    Dim lRes As Long
    
    tSI.GdiplusVersion = 1
    lRes = GdiplusStartup(lGDIP, tSI)

   If lRes = S_OK Then
      lRes = GdipCreateBitmapFromHBITMAP(Image.handle, 0, lBitmap)
      If lRes = S_OK Then
         lRes = GdipGetImageThumbnail(lBitmap, Width, Height, lThumb, 0, 0)
         If lRes = S_OK Then
            lRes = GdipCreateHBITMAPFromBitmap(lThumb, hBitmap, 0)
             CreateAndResizeBitmap = hBitmap
            GdipDisposeImage lThumb
         End If
         GdipDisposeImage lBitmap
      End If
      GdiplusShutdown lGDIP
   End If

   If lRes Then Err.Raise 5, , "Cannot load file."

End Function




2- Code Usage example (Standard Module )
VBA Code:
Option Explicit

Sub ShowUserForm()

    Dim oCtrl As MSForms.Control
    Dim oClass As cls_DraggableControl
    Dim oUserForm As Object
    
    Set oUserForm = UserForm1
    
    For Each oCtrl In oUserForm.Controls
        If TypeOf oCtrl Is MSForms.Image Then
            Set oClass = New cls_DraggableControl
            oClass.HookControl ThisClassInstance:=oClass, Ctrl:=oCtrl, UILabel:=oUserForm.Label1
        End If
    Next

    oUserForm.Show
    
End Sub
 

Some videos you may like

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

Watch MrExcel Video

Forum statistics

Threads
1,118,297
Messages
5,571,404
Members
412,387
Latest member
qxyy
Top