Drag and drop entre 2 listview

[aspe]

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.

 

[aspe]

Re : Drag and drop entre 2 listview

petit up du soir, Espoir...

 

[ChTi160]

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

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

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

 

[Bebere]

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

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...

 

[aspe]

Re : Drag and drop entre 2 listview

Bonjour ChTi160, Bebere, le forum,

Merci de vous être penché sur le fichier, j'essaie d'appliquer vos propositions et vous tiens informés.

Cordialement

Aspe

 

[aspe]

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.

 

[aspe]

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

 

[Bebere]

Re : Drag and drop entre 2 listview

Aspe
met le code quelqu'un trouvera où çà coince
malheureusement je ne sais rien faire avec ton fichier trop à changer

 

[aspe]

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

 

[ChTi160]

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.

 

[Bebere]

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

 

[aspe]

Re : Drag and drop entre 2 listview

Bonjour à tous,

ChTi160

Bonjour aspe
bonjour Bebere ,le Forum

pas évident de comprendre ce que tu veux ?????

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

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

 

[Bebere]

Re : Drag and drop entre 2 listview

Aspe
mis une feuille excel 2003 et copier les données et le code ok
ajout code userform_initialize
pour transfert vers listview2 voir
Private Sub ListView1_ItemCheck(ByVal Item As MSComctlLib.ListItem)

 

[Si...]

Re : Drag and drop entre 2 listview

salut

pas de Drag, ça ressemble … et c’est tout comme : voir Si… ces déplacements* d’une liste à l’autre peuvent convenir.

Le fichier fourni est lourd donc je n'y touche pas.

 

[aspe]

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