Discussion :

[McLister213]

Bonjour à tous !

Etant nouveau sur le forum, je fais appelle à vous car j'ai besoin d'aide pour transférer item d'une listbox à une listview, je m'explique... Je ne connaissais pas le VBA et très mal Excel il y a un mois. Jusqu'à maintenant, j'ai réussi à me débrouiller seul et d'ailleurs pour cela je remercie grandement votre site, les personnes qui ont consacrées tout les tutoriels présents sur le VBA, ainsi que votre forum très actif ou j'ai pu piocher du code à droite à gauche. Mais maintenant je fais impasse sur certains détails qui me bloque et sans réponse sur la toile. Bref parenthèse fermée voilà ma demande :

Ce qui est fait :

• 1. J'ai un tableau avec des données que je transfère sur une ListView qui est lui-même présent dans un UserForm
  Données sur le tableau : Phase - Activité - Reference - Description - etc... - Contrôle
  Données sur la ListView : Phase - Activité - Reference - Description - Contrôle
  
• 2. De ma ListView je choisi les données dont j'ai besoin et que je transfère sur ma ListBox en déformant ces données. Pour ajouter ces données j'utilise soit un bouton, soit un double clique
  Données sur la ListBox (telle que je l'ai codé) : "Référence" & " - " & "Description"
  
• 3. Les données de ma ListBox servent à crée une fiche sur une nouvelle feuille de mon excel etc...

Ce que j'aimerai :Quand on supprime un Item d'une ListBox, il puisse se rajouter dans ma ListView. Un transfère tout simplement.
Au passage, j'ai utilisé une ListView par rapport aux possibilité de colorier les lignes sur certaines données. Sinon j'aurai utilisé une listBox.


J'ai essayé de réactualiser ma ListView mais du coup tout les items réapparaissent y compris ceux qui sont présents dans la ListBox et c'est cela qui posent problème.

Grand merci d'avance de votre réponse !
PS : Si vous avez besoin de détails ok mais par soucis de confidentialité je ne pourrai pas transmettre certaines informations.

voilà les codes :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
'**********************************************************
'Bouton qui supprime les points choisis dans la ListBox
'**********************************************************
Private Sub CommandButton1_Click()
If ListBox430.Value <> "" Then
    ListBox430.RemoveItem ListBox430.ListIndex
End If
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
'*******************************************************
'Procédure permettant d'actualiser (ou de rafraichir)
'les données de la ListView et mettre de la mise en
'forme conditionnelle
'*******************************************************
 
Private Sub Actualisation()
 
    'Déclaration des variables
    Dim Item As ListItem
    Dim Dernier_430 As Integer
    Dim i As Integer
    Dim Couleur As Variant
    Dim MonCritere As Variant
 
    ListView430.ListItems.Clear 'On vide le contenu de la liste à chaque chargement
    Dernier_430 = Sheets("Fiche de contrôle 430").Cells(Rows.Count, 1).End(xlUp).Row 'On cherche la dernière ligne du tableau
 
    'On boucle toutes les lignes et on charge les informations dans la liste View
    For i = 21 To Dernier_430
 
        'On definit le critère sur lequel la couleur sera appliquée
         MonCritereConforme = Sheets("Fiche de contrôle 430").Cells(i, 10) 'Test des points 430
         MonCritereNonConforme = Sheets("Fiche de contrôle 430").Cells(i, 11)
 
        If (MonCritereNonConforme >= 1) Then
            Couleur = RGB(192, 0, 0)
        ElseIf (MonCritereConforme >= 1) Then
            Couleur = RGB(0, 130, 4)
        Else: Couleur = RGB(0, 0, 0)
 
        End If
 
 
            'On affiche dans la ListView le contenue de la base de données
            Set Item = ListView430.ListItems.Add(Text:=Sheets("Fiche de contrôle 430").Cells(i, 1))
 
            Item.SubItems(1) = Sheets("Fiche de contrôle 430").Cells(i, 2)
            Item.ListSubItems(1).ForeColor = Couleur
            Item.SubItems(2) = Sheets("Fiche de contrôle 430").Cells(i, 3)
            Item.ListSubItems(2).ForeColor = Couleur
            Item.SubItems(3) = Sheets("Fiche de contrôle 430").Cells(i, 4)
            Item.ListSubItems(3).ForeColor = Couleur
            Item.SubItems(4) = Sheets("Fiche de contrôle 430").Cells(i, 9)
    Next i
 
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
'*******************************************************
'Initialisation de la ListView au démarrage du formulaire
'*******************************************************
Private Sub userForm_Initialize()
'Initialisation au démarrage du formulaire
    With ListView430
 
        .LabelEdit = 1 'Empeche la modification de la 1er colonne
        .Gridlines = True 'Affiche ou pas les lignes
        .View = lvwReport 'Style du rapport
        .FullRowSelect = True 'Permet de sélectionner une ligne dans la liste
        'Création des en-têtes personnalisées avec leur largeur
        .ColumnHeaders.Add Text:="Phase", Width:=40
        .ColumnHeaders.Add Text:="Activite", Width:=80
        .ColumnHeaders.Add Text:="Reference", Width:=50
        .ColumnHeaders.Add Text:="Description", Width:=400
        .ColumnHeaders.Add Text:="Contrôle", Width:=40
 
    End With
 
    Call Actualisation 'On appel la procédure qui actualise la ListView   
 
End Sub

[Theze]

Bonjour,

Une piste avec une ListBox nommée ListBox1 et une ListView nommée ListView1. Code à mettre dans le module de la Form. Sur un double clic dans la ListBox, la valeur est transférée dans la ListView et supprimée de la ListBox. Faire d'abords un test sur une Form vierge contenant ces deux contrôles afin de voir si le résultat convient :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
 
Private Obj As DataObject
Private Action As Integer
 
Private Sub UserForm_Initialize()
 
    Dim I As Integer
 
    With Me.ListBox1
 
        For I = 1 To 10: .AddItem "Essai " & I: Next I
 
    End With
 
    With ListView1
 
        .ColumnHeaders.Add , , "Colonne 1", 200
        .View = lvwReport
        .OLEDragMode = ccOLEDragAutomatic
 
    End With
 
End Sub
 
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
 
        Set Obj = New DataObject
 
        With ListBox1: Obj.SetText .Text: End With
 
        Action = Obj.StartDrag
 
End Sub
 
Private Sub ListBox1_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)
 
    Cancel = True
    Effect = 2
 
End Sub
 
Private Sub ListBox1_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, _
                                       ByVal Action As MSForms.fmAction, _
                                       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 = 2
 
    With ListBox1: .RemoveItem .ListIndex: End With
    ListView1.ListItems.Add , , Obj.GetText
 
End Sub

[McLister213]

Salut à toi,

Effectivement c'est ce que je cherche, j'ai testé et cela fonctionne à merveille. Serait-il également possible de rajouter un bouton "supprimer" ? (en gardant le double clique qui est pratique).
Par contre la ou ça va poser problème c'est sur l'adaptation du code sur mon formulaire.Vu qu'il y aura en plus à prendre en charge les données du tableau qui sont déjà importés sur ma ListView (et le code couleur si possible par la même occasion) ça risque d'être un peu chaud.

Une image vaut mieux que des paroles, voilà à quoi ressemble le formulaire :
Ce qui est caché en rouge correspond à la "description". Ce qui est caché en noir on s'en occupe pas



Au passage j'avais pour solution que, une fois supprimer de la ListBox, on créer une nouvelle procédure qui réactualiserait La ListView mais sans les éléments qui sont déjà présent dans la ListBox.
On aurait comme ça juste à appeler la procédure avec "Call Actualisation 2" par exemple dans la fonction qui supprime l'item de la ListBox. Mais encore une fois, je sais pas trop comment me dépatouiller niveau code.

En tout cas je te remercie pour ton aide.

[McLister213]

Re

En faite c'est bon j'ai réussi en créant une nouvelle procédure qui prend dans la listbox et qui recherche dans mon tableau. J'ai même les couleurs qui vont avec . J'ai juste à l'appeler lors de mon action sur le bouton supp ou double clique dans la ListBox430.

Les codes :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'**********************************************************
'Bouton qui supprime les points 430 choisi dans la ListBox
'**********************************************************
 
Private Sub CommandButton1_Click()
 
'supprimer item dans la liste des points 430
If ListBox430.Value <> "" Then
    Call ActualisationSupp
    Total_Point.Caption = ListBox430.ListCount - 1
    ListBox430.RemoveItem ListBox430.ListIndex
End If
 
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Private Sub ActualisationSupp()
 
'*******************************************************
'Procédure permettant d'ajouter l'item supprimer dans
'la ListBox430
'*******************************************************
 
    'Déclaration des variables
    Dim Item As ListItem
    Dim Dernier_430 As Integer
    Dim Couleur As Variant
    Dim MonCritereConforme As Variant
    Dim MonCritereNonConforme As Variant
 
    Dernier_430 = Sheets("Fiche de contrôle 430").Cells(Rows.Count, 1).End(xlUp).Row 'On cherche la dernière ligne du tableau
 
    'On boucle toutes les lignes et on charge les informations dans la liste View
    For I = 21 To Dernier_430
 
        'On definit le critère sur lequel la couleur sera appliquée
         MonCritereConforme = Sheets("Fiche de contrôle 430").Cells(I, 10) 'Test des points 430
         MonCritereNonConforme = Sheets("Fiche de contrôle 430").Cells(I, 11)
 
        If (MonCritereNonConforme >= 1) Then
            Couleur = RGB(192, 0, 0)
        ElseIf (MonCritereConforme >= 1) Then
            Couleur = RGB(0, 130, 4)
        Else: Couleur = RGB(0, 0, 0)
 
        End If
 
 
    'On repère dans la ListBox l'item sélectionner
    If ListBox430.ListIndex = -1 Then Exit Sub
        titre_430 = ListBox430.List(ListBox430.ListIndex)
 
            'On recherche la ligne dans le tableau
            For ligne = 21 To Dernier_430
                Sheets("Fiche de contrôle 430").Activate
                intitule_430 = Cells(ligne, 3) & " - " & Cells(ligne, 4)
 
                'Si trouver alors on applique sur la ListView
                If intitule_430 = titre_430 Then
                Set Item = ListView430.ListItems.Add(Text:=Sheets("Fiche de contrôle 430").Cells(ligne, 1))
 
                    Item.SubItems(1) = Sheets("Fiche de contrôle 430").Cells(ligne, 2)
                    Item.ListSubItems(1).ForeColor = Couleur
                    Item.SubItems(2) = Sheets("Fiche de contrôle 430").Cells(ligne, 3)
                    Item.ListSubItems(2).ForeColor = Couleur
                    Item.SubItems(3) = Sheets("Fiche de contrôle 430").Cells(ligne, 4)
                    Item.ListSubItems(3).ForeColor = Couleur
                    Item.SubItems(4) = Sheets("Fiche de contrôle 430").Cells(ligne, 9)
                    Exit Sub
                End If
            Next ligne
    Next I
 
End Sub

Par contre...C'est vraiment tout bête mais je n'arrive pas à lui faire dire d'aller à la première ligne...Même si je lui met "ListView430.ListItems(1).Add" ça marche pas. Bon après c'est pas le plus important, mais si vous avez une idée par là.

[unparia]

Bonjour
La méthode Add s'applique à la collection ListItems de la listview, selon cette syntaxe (exemple où l'on spécifie 1 comme index d'insertion) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 ListView1.ListItems.Add 1, , "coucou"

[McLister213]

Effectivement ça marche mieux Il me reste plus qu'a essayer de le trier. merci bien en tout cas

Bon la j'ai encore une autre bidouille qui à rien à voir mais ça me titille. Depuis mes dernière manipulations j'ai un problème de feuille dans l'explorateur de projet. Comme dans cette conversation d'il y a 8 ans :
https://www.developpez.net/forums/d9...rateur-projet/

En faite, on dirait qu'il est liée indirectement au ThisWorkbook. Du moins le logo de la feuille est le même mais impossible de le supprimer.
Du coup j'aimerai bien savoir si il y a un autre moyen de les supprimer (oui car j'en ai 2, "feuil10" et "feuil11") que de copier coller toute les feuilles sur un nouveau classeur ?