Drag and drop entre 2 listview

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion aspe
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
A

aspe

XLDnaute Junior
Bonsoir à tous,

Après plusieurs essais, je n'arrive pas à transférer une sélection faite par checkbox d'une listview1 à une listview2, j'ai tenté le drag and drop sans succès, le multiselect sans succès non plus, probablement du à une mauvaise déclaration de variables. un peu d'aide serait grandement appréciée au vu du temps passé sur la recherche infructueuse de la solution.

Merci par avance.
 

Pièces jointes

Trier par date Trier par votes
Re : Drag and drop entre 2 listview

Bonjour aspe

bonjour le fil,le forum

voila ce que j'ai mis dans le Activate du Userform Selection
puis dans le Click du commandButton5
je n'ai pas finalisé (seules Deux colonnes ajoutées dans ListView 2 du Userform Selection
Code: 
Private Sub UserForm_Activate()
    Me.Caption = "Interrogation Cheptel"
  With Selection
    With .ListView1
         .CheckBoxes = True
         .AllowColumnReorder = True
     Set .Icons = ImageList1
     Set .SmallIcons = ImageList1
    End With
    With .ListView2
         .ColumnHeaders.Clear
         .ColumnHeaders.Add , , "N°", 50
         .ColumnHeaders.Add , , "Bague", 55
         .FullRowSelect = True
         .ListItems.Clear
         .View = lvwReport
    End With
  End With
    Call CBO_Fill
    Call LVW_Fill("", 0)    
End Sub

Code: 
Private Sub CommandButton5_Click()
Dim lgn As Integer
Dim LstVitem As Object
    With Selection     
        For lgn = 1 To .ListView1.ListItems.Count
        Set LstVitem = .ListView1.ListItems(lgn)
          With LstVitem
          If .Checked = True Then
             Selection.ListView2.ListItems.Add , , .Text
             Selection.ListView2.ListItems(Selection.ListView2.ListItems.Count).ListSubItems.Add , , .ListSubItems(1).Text
            .Checked = False
          End If
          End With
        Next lgn
    End With    
End Sub
je n'ai pas beaucoup de temps, mais bon c 'est un debut !
Bonne journée
Amicalement
Jean Marie
 
Vote positif 0 Vote négatif
Re : Drag and drop entre 2 listview

bonjour Aspe
bienvenue
1.-Quel userform,les listview même userform ou différent
2.-erreurs dans le code(excel 2003)
edit: bonjour Jean Marie
pour un début
Code: 
Private Sub Form_Load()
    Dim LstItem As ListItem
    'Ajoute des items au listview1
    Set LstItem = ListView1.ListItems.Add(, , "Element1")
    Set LstItem = ListView1.ListItems.Add(, , "Element2")
    Set LstItem = ListView1.ListItems.Add(, , "Element3")
    Set LstItem = ListView1.ListItems.Add(, , "Element4")
    Set LstItem = ListView1.ListItems.Add(, , "Element5")
End Sub

Private Sub ListView1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    
    'Trouve l'item sélectionné   
    Set ListView1.SelectedItem = ListView1.HitTest(x, y)
    'Indique l'icone visible lors du déplacement
    ListView1.DragIcon = LoadPicture("C:\VB\drag.ico")
    
    'Commence le déplacement
    ListView1.Drag vbBeginDrag
End Sub

Private Sub ListView2_DragDrop(Source As Control, x As Single, y As Single)
    Dim LstItem2 As ListItem
    'Ajoute l'item déplacé dans le listview2
    Set LstItem2 = ListView2.ListItems.Add(, , Source.SelectedItem.Text)
End Sub 


 Rajoutez:
listView1.ListItems.Remove (Source.SelectedItem.Index)

Dans la procédure List_View2_DragDrop afin que l'élément soit déplacé, et non copier vers l'autre ListView...
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Drag and drop entre 2 listview

Re,

Me voilà de retour après quelques modifications. J'arrive a transférer du listview1 au listview2, mais, car il y en a toujours un...

les données transférées n'affichent que le 1er champ "N°" et les lignes s'affichent en colonnes et sans entête de colonne dans le listview2.

J'y retourne pour essayer de comprendre le pourquoi du comment.
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Drag and drop entre 2 listview

Re,

J'ai enfin le transfert, les entêtes de colonnes sur le listview2, et encore le mais...

je ne transfère que les 2 premiers champs, le reste de la ligne est désespérément vide

Capture.jpg
 

Pièces jointes

  • Capture.jpg
    Capture.jpg
    43.2 KB · Affichages: 230
  • Capture.jpg
    Capture.jpg
    43.2 KB · Affichages: 240
Vote positif 0 Vote négatif
Re : Drag and drop entre 2 listview

Merci Bebere pour tes conseils et ton aide. Au plaisir

Si quelqu'un pouvait m'aiguiller...

Le code qui coince:

Option Explicit

Private Sub CommandButton3_Click()


End Sub

Private Sub CommandButton4_Click()
Dim X As Integer
For X = 1 To ListView1.ListItems.Count
ListView1.ListItems(X).Selected = False
ListView2.ListItems(X).Selected = False
Next

Set ListView1.SelectedItem = Nothing
Set ListView2.SelectedItem = Nothing

End Sub

Private Sub TextBox1_Change()
Call LVW_Fill(Trim$(TextBox1.Text), ComboBox1.ListIndex)
End Sub
Private Sub UserForm_Activate()
Me.Caption = "Interrogation Cheptel"
With Selection
With .ListView1
.CheckBoxes = True
.AllowColumnReorder = True
Set .Icons = ImageList1
Set .SmallIcons = ImageList1
End With

With .ListView2
.ColumnHeaders.Clear
.ColumnHeaders.Add , , "N°", 30
.ColumnHeaders.Add , , "Poulailler", 45
.ColumnHeaders.Add , , "Sexe", 55
.ColumnHeaders.Add , , "Race", 55
.ColumnHeaders.Add , , "Couleur", 55
.ColumnHeaders.Add , , "Naissance", 55
.ColumnHeaders.Add , , "Acquisition", 55
.ColumnHeaders.Add , , "Prix", 55
.ColumnHeaders.Add , , "Sortie", 55
.ColumnHeaders.Add , , "jours présence", 55
.ColumnHeaders.Add , , "Soies", 55
.ColumnHeaders.Add , , "Naissance", 55
.ColumnHeaders.Add , , "30 jours et plus", 55
.ColumnHeaders.Add , , "Plus de 2 ans", 55
.ColumnHeaders.Add , , "Pondeuse", 55
.ColumnHeaders.Add , , "moins de 30 jours", 55
.ColumnHeaders.Add , , "Abattus", 55
.ColumnHeaders.Add , , "Perdus", 55
.ColumnHeaders.Add , , "Poids", 55
.ColumnHeaders.Add , , "Notes", 55
.ColumnHeaders.Add , , "Coul. Tête", 55
.ColumnHeaders.Add , , "Coul. Queue", 55
.ColumnHeaders.Add , , "Particularités", 55
.ColumnHeaders.Add , , "Nom", 55
.ColumnHeaders.Add , , "Vendu", 55
.ColumnHeaders.Add , , "Date", 55
.ColumnHeaders.Add , , "N° Lot", 55
.ColumnHeaders.Add , , "Notes abattage", 55
.ColumnHeaders.Add , , "Age en jours", 55
.FullRowSelect = True
.ListItems.Clear
.View = lvwReport
End With
End With
Call CBO_Fill
Call LVW_Fill("", 0)
End Sub


' ------ Tri lors de la sélection d'une colonne ----------
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
ListView1.Sorted = False
ListView1.SortKey = ColumnHeader.Index - 1
If ListView1.SortOrder = lvwAscending Then
ListView1.SortOrder = lvwDescending
Else
ListView1.SortOrder = lvwAscending
End If
ListView1.Sorted = True

End Sub

Private Sub CommandButton2_Click()
Unload Me
SuiviSanitaire.Show
End Sub


Private Sub CBO_Fill()
'Variables locales
Dim iCnt As Integer
Dim oRng As Excel.Range

'Remplit la Combo
Set oRng = Feuil2.Cells(1, 1)
For iCnt = 0 To 34 '-- 33 colonnes
ComboBox1.AddItem oRng.Offset(0, iCnt)
Next iCnt
ComboBox1.ListIndex = 0
End Sub

Private Sub ListView1_ItemCheck(ByVal Item As MSComctlLib.ListItem)
Dim j As Integer
If Item.Checked = True Then
Item.ForeColor = RGB(0, 0, 255) 'Changement couleur
Item.Bold = True 'Gras
For j = 1 To Item.ListSubItems.Count
Item.ListSubItems(j).ForeColor = RGB(0, 0, 0)
Item.ListSubItems(j).Bold = True
Next j
Else
Item.ForeColor = RGB(1, 0, 0) 'Changement couleur
Item.Bold = False

For j = 1 To Item.ListSubItems.Count
Item.ListSubItems(j).ForeColor = RGB(1, 0, 0)
Item.ListSubItems(j).Bold = False
Next j

End If

End Sub

Private Sub LVW_Fill(ByVal sFilter As String, ByVal iCol As Integer)
'Variables locales
Dim iCnt As Integer
Dim iRnd As Integer
Dim oRng As Excel.Range
Dim oItem As ListItem

'Initialisation de la ListView
ListView1.ColumnHeaders.Clear
ListView1.FullRowSelect = True
ListView1.ListItems.Clear
ListView1.View = lvwReport

'Remplissage de la ListView
Set oRng = Feuil2.Cells(1, 1)
Do Until oRng.Offset(1, 0).Value = ""
'-- En-têtes
If oRng.Row = 1 Then
For iCnt = 0 To 32 '-- 33 colonnes
ListView1.ColumnHeaders.Add , , oRng.Offset(0, iCnt)
Next iCnt
'-- Données
Else
iRnd = Int((4 * Rnd) + 1)
If LCase$(Left$(oRng.Offset(0, iCol), Len(sFilter))) = LCase$(sFilter) Then
Set oItem = ListView1.ListItems.Add(, , oRng.Offset(0, 0), "Key" & iRnd, "Key" & iRnd)
For iCnt = 1 To 33 '-- 33 colonnes
oItem.ListSubItems.Add , , oRng.Offset(0, iCnt)
Next iCnt
End If
End If
Set oRng = oRng.Offset(1, 0)
Loop
End Sub

Private Sub CommandButton5_Click()
Dim lgn As Integer
Dim LstVitem As Object
With Selection
For lgn = 1 To .ListView1.ListItems.Count
Set LstVitem = .ListView1.ListItems(lgn)
With LstVitem
If .Checked = True Then
Selection.ListView2.ListItems.Add , , .Text
Selection.ListView2.ListItems(Selection.ListView2.ListItems.Count).ListSubItems.Add , , .ListSubItems(1).Text
.Checked = False
End If
End With
Next lgn
End With

End Sub

Private Sub CommandButton1_Click()
Dim c As Control
For Each c In Me.Controls
Select Case TypeName(c)
Case "TextBox"
c.Value = ""
Case "ListBox", "ComboBox"
c.Value = ""
ListView1.ListItems.Clear
c.Value = ""
End Select
Next c
End Sub

'Private Sub CommandButton2_Click() 'bouton "Quitter"
'Unload Me 'vide et ferme l'UserFOrm
'End Sub
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
Re : Drag and drop entre 2 listview

Bonjour aspe
bonjour Bebere ,le Forum

pas évident de comprendre ce que tu veux ??????
tu dis simplement "Le code qui Coince"
mais un peu d'aide ou ,quoi ,quand ,comment, ca coince ,pas evident !!!!!!
merci de nous eclairer
comme le dit Bebere il serait bon que tu nommes tout cela (les controles) de façon plus intuitive.
 
Vote positif 0 Vote négatif
Re : Drag and drop entre 2 listview

bonjour Aspe,Jean Marie
icol=-1 valeur de combobox1.listindex
essaye comme suit Mid(ComboBox1, 3) prend la valeur de l'entrée
je pense que tu devrais mettre un bouton pour valider,si tu veux entrer plus d'un caractère

Private Sub TextBox1_Change()
Call LVW_Fill(Trim$(TextBox1.Text), Mid(ComboBox1, 3))
End Sub
 
Vote positif 0 Vote négatif
Re : Drag and drop entre 2 listview

Bonjour à tous,

ChTi160
Bonjour aspe
bonjour Bebere ,le Forum

pas évident de comprendre ce que tu veux ?????
Cliquez pour agrandir...

Je souhaite afficher une sélection faite sur l'onglet "Cheptel" avec l'usf selection, puis renvoyer les infos "N°" sélectionnés dans l'usf "suivi sanitaire" pour y ajouter des traitements à effectuer en complétant les textbox correspondants, puis copier les infos de l'usf "suivi sanitaire" dans la feuille "sanitaire", Ensuite j'ai un autre fichier que je n'ai pas mis ici qui déclenche des rappels selon les dates, mais ça c'est une autre histoire...

Ca coince dans le sens ou les infos sélectionnées dans listview1 n'affichent que 2 colonnes dans le listview 2 et que c'est insuffisant pour effectuer un contrôle visuel avant de traiter les infos.

Bebere
bonjour Aspe,Jean Marie
icol=-1 valeur de combobox1.listindex
essaye comme suit Mid(ComboBox1, 3) prend la valeur de l'entrée
je pense que tu devrais mettre un bouton pour valider,si tu veux entrer plus d'un caractère

Private Sub TextBox1_Change()
Call LVW_Fill(Trim$(TextBox1.Text), Mid(ComboBox1, 3))
End Sub
Cliquez pour agrandir...

J'ai testé les modifs, cela m'affiche listview et combobox vide.

je regarde de mon côté si je peux contourner le problème plutôt que s'acharner des jours et des nuits...

Encore merci à vous deux.

Cordialement
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Drag and drop entre 2 listview

Merci,

Juste un message d'erreur pour Call LVW_Fill(Trim$(TextBox1.Text), Mid(ComboBox1, 3))
que j'ai réglé en passant en non modal.

Super, je vais pouvoir poursuivre...

Allez en route vers de nouvelles aventures.

et encore Merci
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

M
  • Résolu(e)
XL 2021 Problème d'activation d'une macro pour transférer des valeurs d'une feuille 1 à une feuille 2
Réponses
3
Affichages
154
MATLEA
M
V
  • Question Question
XL 2013 drag and drop depuis userform listbox vers cellules (2)
Réponses
3
Affichages
540
val38
V
B
  • Question Question
Microsoft 365 Drag and Drop entre deux listview
Réponses
4
Affichages
909
bibbip35
B
N
  • Résolu(e)
XL 2021 Jointure Excel multicritères
Réponses
3
Affichages
443
Nasseuz
N
T
  • Question Question
XL 2016 EXCEL VBA : empecher copier/coller et DragAndDrop sur les 2 onglets d'un fichier, mais pas sur d'autres fichier alors que le 1er fichier reste ouvert
Réponses
1
Affichages
1 K
Thibthib
T
S
  • Résolu(e)
XL 2019 SIERREUR pour 2 conditions + critères uniques répétés + période entre deux dates ( ENTRETIENS ANNUELS PROFESSIONNELS )
Réponses
7
Affichages
2 K
SOSjeBloque
S
N
  • Question Question
XL 2010 glisser - déposer (drag and drop) en VBA
Réponses
4
Affichages
5 K
nounbxl76
N
P
  • Question Question
Drag and Drop entre deux listboxs + lien avec une troisième
Réponses
14
Affichages
1 K
pumbathekings
P
L
  • Question Question
Drag and Drop limité à une plage de cellule
Réponses
3
Affichages
2 K
loulou2011
L
S
  • Question Question
Userform - Drag and Drop - Glisser Déplacer
Réponses
5
Affichages
6 K
vbacrumble
vbacrumble
C
  • Question Question
"drag & drop" entre deux listview - bug de procédure !!
2
Réponses
24
Affichages
4 K
CAPRI_456
C
M
  • Question Question
Drag and drop entre excel et une windows form
Réponses
0
Affichages
1 K
Macro
M
M
[REF] Wiki 2 de MichelXld (Ce qui touche aux UserForm)
Réponses
0
Affichages
116 K
MichelXld
M
T
  • Question Question
Drag and drop
Réponses
2
Affichages
2 K
ThierryR
T
A
  • Question Question
Drag and drop ListBox multi colonnes
Réponses
2
Affichages
2 K
Alain
A
Retour