Deplacement avec souris

Bonjour à tous et à toutes

une question, .....peu être bizarre pour certaines, afin d’améliorer mes fichier et faciliter leur utilisation, je pose une question :

y a t il un moyen de faire un déplacement de de ligne ou d'informations d'un listbox ( ou lisview) à un autre avec seulement la souris et une action avec un bouton????

merci beaucoup pour votre aide

Bonjour Iliyes,

Ou se trouvent ces Listbox (Feuille ou USF) ?

Sinon normalement avec l'évènement

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

End Sub

Il y a moyen de faire des choses

A+

ben.... J'essaierais ce soir.... Merci pour l'information. Aussi les listbox ou listview se trouve dans un userform.

Bonsoir Iliyes, BrunoM45,

Voici un complément. Prendre le tableau de 3 colonnes fourni et le placer en A1 d'une feuille appelée BD.

Réalise un Userform avec 2 ListBox. Le 1 pour la base de données et le 2 pour montrer la sortie d'un membre de la base de données.

Lance le formulaire puis avec le bouton gauche de la souris prends une ligne (exemple Dupond Louis) en ListBox1 (par appui bouton gauche) et déplace la souris en maintenant le bouton vers la ListBox2 puis relâche le bouton sur celle-ci.

Private Sub ListBox2_BeforeDragOver(ByVal Cancel As _
 MSForms.ReturnBoolean, ByVal Data As _
 MSForms.DataObject, ByVal X As Single, _
 ByVal Y As Single, ByVal DragState As Long, _
 ByVal Effect As MSForms.ReturnEffect, _
 ByVal Shift As Integer)
 Cancel = True
 Effect = 1
End Sub

Private Sub ListBox2_BeforeDropOrPaste(ByVal _
 Cancel As MSForms.ReturnBoolean, _
 ByVal Action As Long, ByVal Data As _
 MSForms.DataObject, ByVal X As Single, _
 ByVal Y As Single, ByVal Effect As _
 MSForms.ReturnEffect, ByVal Shift As Integer)
 Cancel = True
 Effect = 1
 ListBox2.AddItem Data.GetText
End Sub

Private Sub ListBox1_MouseMove(ByVal Button As _
 Integer, ByVal Shift As Integer, ByVal X As _
 Single, ByVal Y As Single)
 Dim MyDataObject As DataObject
 If Button = 1 Then
 Set MyDataObject = New DataObject
 Dim Effect As Integer
 Z = ListBox1.ListIndex
 MyDataObject.SetText ListBox1.Value
 Effect = MyDataObject.StartDrag
 ListBox1.RemoveItem (Z)
 Sheets("BD").Rows(Z + 2).EntireRow.Delete
 End If
End Sub

Private Sub UserForm_Initialize()
 Set f = Sheets("BD")
 Me.ListBox1.List = f.Range("A2:C" & f.[A65000].End(xlUp).Row).Value
 Me.TextBox1 = Application.Sum(Application.Index(Me.ListBox1.List, , 3))  ' colonne 3
End Sub

Edit: Bien mettre 3 colonnes au premier ListBox1

merci a vous deux. J'essaierais ce soir. Ça m'aiderais énormément. Mais je clôture pas encore le sujet

hello

X Cellus et BrunoM45

ben.... ca fonctionne tes tres bien, une question si c'est possible:

si j'ai bien compris le process c'est si j'ai à faire ouvrir un autre userform ( userform2 par exemple) je doit faire l'action dans

Private Sub ListBox2_BeforeDropOrPaste(ByVal _
 Cancel As MSForms.ReturnBoolean, _
 ByVal Action As Long, ByVal Data As _
 MSForms.DataObject, ByVal X As Single, _
 ByVal Y As Single, ByVal Effect As _
 MSForms.ReturnEffect, ByVal Shift As Integer)

pour que

Cancel = True
 Effect = 1
 ListBox2.AddItem Data.GetText

soit appliqué !!!

Bonjour X Cellus et BrunoM45

voila voila, j'ai pu faire ce que je voulais... ca fonctionne bien.

neanmoins, je vous solicité pour une autre aide, dans le meme but

je voudrais adapter se qu'a afit X Cellus pour des listview ( dans un userform bien sur) et j'ai trouvé cela

Private Sub ListView1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)

merci d'avance si vous pouvez m'aider ou m'orienter

Re-Bonjour à tous

en faisant des recherche, j'ai pu trouver cela

pour celui qui veut adapter

j'ai déniché du site

https://www.excel-pitin.net/single-post/excel-vba-2つのlistview間でアイテムをドラッグ＆ドロップで移動したり、リストを並べ替えたり

Bonjour Iliyes,

Intéressant programme fonctionnant à partir d'initialisation d'Array au lancement du formulaire.

Puis transformé en liste.

Note que le bouton Up (vert) n'est pas opérationnel car il manque une ligne de code dans le Module 1.

Macro Public Sub selectionMoveUp

 For row1 = 1 To itemCnt
        With lv.ListItems(row1)
            If .Selected = True Then
                Dim txt As String: txt = .Text
                For subIdx = 1 To subItemCnt
                    arraySubItems(subIdx) = .SubItems(subIdx)
                Next
                row2 = .Index - 1  'ici il faut rajouter ce code afin que le bouton marche
                If row2 < 1 Then Exit Sub
                lv.ListItems.Remove (.Index)

re X Cellus

merci beaucoup pour le test complet ( j'ai fait un test rapide, en combinant le tous....enfin)

la ou je block c'est de remplir la lisview1 ( indirectement aussi la listview2) avec un tableau dynamique avec un DerLig et un DerCol comme ca, ca se serais tres flexible, j'espere y arriver, et je le partagerais

merci beaucoup

A nouveau,

Si l'initialisation se fait par un array. C'est parce qu'il y a peu de données. Puis cela devient une liste ensuite, pour se conformer à la Listview.

Mais il est tout à fait possible d'initialiser le formulaire à partir d'un tableau.

Je laisserais un exemple bientôt. Demain.

bonjour X Cellus

j'attends avec impatience le resultat du travaile avec un tableau ( je bug pour le moment)

le resultat devrais etre tres pratique pour le changement d'informations entre 2 tableaux

a vous relire

Bonjour Iliyes,

Voici le fichier sous forme d'alimentation liste des tableaux et non sous forme d'array.

Un seul tableau peut être renseigné ou les deux. Les deux listes s'adaptent à cette configuration.

Et les transferts entre les deux sont effectifs.

bonjour X Cellus

c'est deja sublime...

je suis en train de voir et d'essayer d'adapter à un tableau flexible....je ne c'est pas si c'est faisable

a vous relire

re

ben..... je n'ai toujours pas pu ....ajouter une colonne dans le tableau de la feuille BD, et bien sure DB et ca augmente automatiquement dans les listview....

pensez-vous que c'est possible e le faire

A nouveau,

Il faut bien sur modifier l'initialisation du Formulaire. Exemple: si l'on ajoute une colonne Age

Donc en début de celui-ci.

'  Dimensionnement et constantes des Tableaux
    Dim headers As String, One(4) As String ' >ICI modifié par 4 au lieu de 3
    Dim C, L, DerLig, DerCol As Integer
     ' Nom des En-têtes des colonnes
    With Sheets("BD")
    C = Sheets("BD").Cells(1, Columns.Count).End(xlToLeft).Column
    For T = 1 To C
    One(T) = "," & .Cells(1, T)
    Next T
    End With
    'Nombre de colonnes et dimensions modifiées par ajout de la colonne supplémentaire Age
    headers = One(1) & ",30,0" & vbNewLine & One(2) & ",70,0" & vbNewLine & One(3) & ",60,0" & vbNewLine & One(4) & ",70,0"

re

sur ce coté, j'ai bien compris, et j'ai realisé avec4 et 5 colonnes.

voici ce que j'ai pensé réalisé.

si on cree un tableau1, et tableau2 ( bien sur identique, sauf le nom) forcement il y aurais

DerLig = Range("tableau1").ListObject.ListRows.Count ' Nombre de lignes
DerCol = Range("tableau1").ListObject.ListColumns.Count ' Nombre de colonnes

et...la...automatiquement les headers se cree et le changement d'information entre les 2 tableaux.

y aurai t il une possibilité a cela???

Suite,

Cela demande à modifier légèrement si tu passes par un tableau structuré.

'  Dimensionnement et constantes des Tableaux
    Dim headers As String, One(4) As String 'Note: One s'applique aux 2 listes selon la même structure de tableau
    Dim C, L, DerLig, DerCol As Integer
    DerLig = Range("Tableau1").ListObject.ListRows.Count
    DerCol = Range("Tableau1").ListObject.ListColumns.Count
     ' Nom des En-têtes des colonnes
    For Each Cel In Range("Tableau1[#Headers]")
    T = T + 1: One(T) = "," & Cel.Value
    Next
    'Nombre de colonnes et leurs dimensions choisies s'appliquant aux 2 listes
    headers = One(1) & ",30,0" & vbNewLine & One(2) & ",70,0" & vbNewLine & One(3) & ",60,0" & vbNewLine & One(4) & ",70,0"
    'Setting des En-têtes de listes
    Call setLvHeaders(ListView1, headers, vbNewLine, ",")
    Call setLvHeaders(ListView2, headers, vbNewLine, ",")

    ' Alimentation Par Tableaux en feuilles BD et/ou DB
    '---------------- Tableau n° 1
    L = DerLig - 1  'Corriger pour L par rapport à la dernière version
    C = DerCol - 1  'C restant identique

Bonjour X Cellus

avant tous, mes remerciements pour tous ce que vous faites

donc voila ...pour le post d'avant, cela fonctionne correctement en transformant les 2 tableaux en tableaux structuré Tableau1 et Tableau2, sans rien changer dans la macro ( juste en ajoutant une colonne dans les tableaux

donc en piece jointe le fichier fonctionnelle.

mon grand soucis est le suivant.

y a t il un moyen d'ajouter une colonne ( bien sur identique dans les 2 tableaux sans touché à la macro ( One(4) qui deviendra One(DerCol))???

merci d'avance