Przykład "przeciągania" a więc Drag-and-Drop w Excelu..   strona główna:
A po co ten Excel ;-)
    Zdecydowałem się opublikować i opisać kod tego przykładu bo procedur wykorzystujących przeciąganie w Excelu jest okrutnie mało.  
Są zdarzenia:  
 - BeforeDragOver Event  
 - BeforeDropOrPaste Event  
ale o przykłady ich wykorzystania dość trudno :-|  
    Ciekawy przykład na wykorzystanie tego mechanizmu "swego czsu" znalazłem w sieci na stronie Stephen'a Bullen'a -->>>   Stephen Bullen's Excel Page 
Okazuje się że ListView ma też inne zdarzenia które pomogą nam ogarnać temat (pogrubione wykorzystałem w przykładzie). Są to:   
 - ListView1_OLEStartDrag   szukajcie:
 - ListView1_OLECompleteDrag   DragDrop.exe  (30 April 1998)
Self-installing exe.
This is an example of how to program the TreeView and ListView controls found in the Windows Common Controls OCX, paying particular attention to the drag-and-drop features of these controls.
 - ListView1_OLEDragDrop  
 - ListView1_OLEDragOver  
 
Pomysł polega na:  
1. załadowaniu do ImageList zdjęć
 
2. zawartość ImageList załadować do ListView  
3. umożliwić "przeciąganie" elementów ListView na kontrolkę Image1  
    która będzie tłem i granicą dla przeciąganych elementów  
4. elementy można będzie przemieszczeć dowolnie po Image1  
5. elementy można usuwać.  
 
    Pierwsze działania nie wymagają nawet linijki kodu..  
 - Wstawiamy na UserForm:  
     Microsoft ImageList Control   trochu poza tematem:
     Microsoft ListView Control   ListView ActiveX Control
(masa fajnych przykładów)
 
 
 
 
 
 
 
 
 
                                                                                                             Żeby załadować zdjęcia które będą elementami ListView   
                                                                                                             (będziemy je "przeciągać na Image1) do ImageList  
 
 
 
 
 
 
 
 
 
 
                                                                                                      … i mamy zdjęcia :-)  WCC są pod tym względem rewelacyjne ;-)  
 
 
 
 
 
    Elementy załadowane do ListView powinno dać  
się przeciągać na zewnątrz a nie wewnątrz kontrolki.  
Ustawienie właściwości OLEDragMode załatwi sprawę.  
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
Reszta kodem… Nie prezentuję całości a zachowam kolejności powstawania.  
 
W mod. Standardowym  
 
Public Type pozType  
    x As Single  
    y As Single  
    XMax As Single  
    YMax As Single  
End Type  
 
Public pozGranica As pozType  
 
Public clsNewImgColl As VBA.Collection  
 
Jeżeli kilka informacji jest mi potrzebne w danym momencie a użyskanie tych informacji zachodzi w tym samym czasie grypuję taki zestaw  
danych w Typ Użytkownika. Elementy przeciągane na Image1 muszą być utworzone /przeciągane w granicahc tej kontrolki dlatego deklaruję  
zmienną pozGranica do której zapiszę wymiary Image1.  
Żeby mieć dostęp do zdarzeń elementów przeciągniętych z ListView na Image1 będę potrzebował napisać klasę w której będę miał dostęp   
do utworzonego obiektu. Potrzebna będzie kolekcja na przechowywanie zainicjowanych klas.  
 
Private Sub UserForm_Initialize()  
    Dim i As Integer  
      
    Set clsNewImgColl = New VBA.Collection  
      
    With Me.ListView1  
        .SmallIcons = Me.ImageList1  
        .Icons = Me.ImageList1  
        
        For i = 1 To Me.ImageList1.ListImages.Count  
            .ListItems.Add Text:="Obraz: " & i, Icon:=i  
        Next  
    End With  
      
    With Me.Image1  
        pozGranica.x = .Left  
        pozGranica.y = .Top  
        pozGranica.XMax = .Left + .Width  
        pozGranica.YMax = .Top + .Height  
    End With  
          
End Sub  
 
Private Sub UserForm_Terminate()  
    Set clsNewImgColl = Nothing  
End Sub  
 
     Przy UserForm_Initialize inicjuje kolekcję na nowe obiekty przeciągnięte z ListView, ładuję do ListView zdjęcia z ImageList i zapisuję  
granicę Image1. w UserForm_Terminate zwalniam pamięć dla kolekcji klas.  
 
     .. Zaczynamy "przeciąganie"…  
 
Private Sub ListView1_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)  
    Set moDragItem = Me.ImageList1.ListImages(Me.ListView1.SelectedItem.Index).Picture  
End Sub  
 
Do prywatnej zmiennej moDragItem poziomu mod.UserForm zapisuję zdjęcie wybranego elementu ListView.  
 
Private Sub Image1_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, _  
                                  ByVal Data As MSForms.DataObject, _  
                                  ByVal x As Single, ByVal y As Single, _  
                                  ByVal DragState As MSForms.fmDragState, _  
                                  ByVal Effect As MSForms.ReturnEffect, _  
                                  ByVal Shift As Integer)  
    With ImpPoint  
        .x = pozGranica.x + x  
        .y = pozGranica.y + y  
    End With  
    Me.Image1.MousePointer = fmMousePointerArrow  
End Sub  
 
Podczas przeciągania.. Do Prywatnej zmiennej ImpPoint typu ImpPointInfo:  
 
Private Type ImgPointInfo  
    x As Single  
    y As Single  
End Type  
Private ImpPoint As ImgPointInfo  
 
   zapisuję aktualne miejsce przeciągnięcia (MousePointer - później). Przy upuszczaniu..  
 
Private Sub ListView1_OLECompleteDrag(Effect As Long)  
      
    With pozGranica  
        If ImpPoint.x > .x And (ImpPoint.x + 10) < .XMax And _  
           ImpPoint.y > .y And (ImpPoint.y + 10) < .YMax Then  
 
            Dim iImage As MSForms.Image  
            Static i As Long: i = i + 1  
            Set iImage = Me.Controls.Add("Forms.Image.1")  
            With iImage  
                .Name = "nowa" & i  
                .Picture = moDragItem  
                .PictureSizeMode = fmPictureSizeModeStretch  
                .Width = moDragItem.Width / moDragItemSizeToPixel  
                .Height = moDragItem.Height / moDragItemSizeToPixel  
                  
                .Top = ImpPoint.y  
                .Left = ImpPoint.x  
            End With  
              
            Dim clsObj As clsImage  
            Set clsObj = New clsImage  
            With clsObj  
                Set .SetObj = iImage  
                .LetName = iImage.Name  
            End With  
 
            clsNewImgColl.Add clsObj, iImage.Name  
              
            Set iImage = Nothing  
            Set moDragItem = Nothing  
            'Set moIcon = Nothing  
        End If  
        With ImpPoint  
            .x = 0  
            .y = 0  
        End With  
    End With  
    Me.Image1.MousePointer = fmMousePointerDefault  
End Sub  
 
Sprawdzam czy zapisane miejsce przeciągnięcia (w ImpPoint) mieści się w pozGranica. Jeżeli tak  
 
            Dim iImage As MSForms.Image  
            Static i As Long: i = i + 1  
            Set iImage = Me.Controls.Add("Forms.Image.1")  
            With iImage  
                .Name = "nowa" & i  
                .Picture = moDragItem  
                .PictureSizeMode = fmPictureSizeModeStretch  
                .Width = moDragItem.Width / moDragItemSizeToPixel  
                .Height = moDragItem.Height / moDragItemSizeToPixel  
                  
                .Top = ImpPoint.y  
                .Left = ImpPoint.x  
            End With  
 
tworze nową kontrolkę Image i zapisuje w niej zdjęcie - przeciągnięty element ListView..  
 
            Dim clsObj As clsImage  
            Set clsObj = New clsImage  
            With clsObj  
                Set .SetObj = iImage  
                .LetName = iImage.Name  
            End With  
 
            clsNewImgColl.Add clsObj, iImage.Name  
 
inicjuję nową instancję klasy clsImage (o niej później), zapisuję że jej obiektem będzie moja nowa kontrolka Image i zapisuję tę instancję  
klasy w kolekcji clsNewImgColl.  
  Naprawe godne zerknięcia:
clsImage…    
  www.cpearson.com
Introduction To Classes
Private WithEvents objImage As MSForms.Image  
Private sName As String  
   
Public Property Set SetObj(oImage As MSForms.Image)   www.vb4all.pl
Procedury Property
    Set objImage = oImage  
End Property  
   
Public Property Let LetName(ByVal sObjName As String)  
    sName = sObjName  
End Property  
 
Public Property Get GetName() As String  
    GetName = sName  
End Property  
 
    obiektem klasy będzie objImage jego nazwa poprzez Property Let LetName zostanie zapisana do zmiennej sName - będzie mi to   
potrzebne.  
 
No i obsługa zdarzeń objImage.. (przesuwanie obiektu w granicach Image1 (mouseMove) i usuwanie obiektu (MousDown -xlSecondaryButton)   XlMouseButton Enumeration 
 
Private Sub objImage_MouseDown(ByVal Button As Integer, _  
                               ByVal Shift As Integer, _  
                               ByVal x As Single, ByVal y As Single)  
    Select Case Button ' XlMouseButton  
        Case xlPrimaryButton:  
            With startPoz  
                .x = x: .y = y  
            End With  
        Case xlSecondaryButton: DeleteImage objImage.Name  
    End Select  
      
End Sub  
 
Private Sub objImage_MouseMove(ByVal Button As Integer, _  
                               ByVal Shift As Integer, _  
                               ByVal x As Single, ByVal y As Single)  
    Select Case Button  
        Case xlPrimaryButton:  
            Dim newX As Single, newY As Single  
              
            With startPoz  
                newX = objImage.Left + (x - .x)  
                newY = objImage.Top + (y - .y)  
                  
                With pozGranica  
                    If newX > .x And (newX + objImage.Width) < .XMax Then objImage.Left = newX  
                    If newY > .y And (newY + objImage.Height) < .YMax Then objImage.Top = newY  
                    If newX < .x Then objImage.Left = .x  
                    If newY < .y Then objImage.Top = .y  
                    If (newX + objImage.Width) > .XMax Then objImage.Left = .XMax - objImage.Width  
                    If (newY + objImage.Height) > .YMax Then objImage.Top = .YMax - objImage.Height  
                End With  
            End With  
        Case xlSecondaryButton  
    End Select   przykład do pobrania:
End Sub   Zeszyt1v4.zip
 
..co tu tłumaczyć ? ;-P