Ajouter des informations ds plusieurs lignes avec une LISTBOX

Bonjour, bonjour !

Je viens vers vous car je ne trouve pas la solution à mon "problème" sur les différents forum que j'ai fait, j'espère que quelqu'un sera de bon conseil ici :)

Je m'explique, j'ai créé un formulaire qui permet à une structure de faire son auto-évaluation sur sa manière de gérer ses déchets. Il est organisé de la manière suivante :

1. On sélectionne la catégorie de déchet (listbox1)
2. Une fois la catégorie sélectionner, les différents type de déchets de cette catégorie apparaissent dans la Listbox2. On en sélectionne un.
3. On rajoute ensuite le type de valorisation + si besoin, le prestataire et des commentaires.
4. Quand on sélectionne le bouton Modifier, les résultats sont enregistré dans la BDD appropriée.

Actuellement, le formulaire fonctionne bien quand on complète les informations un types de déchets après l'autre.

Par soucis de gain de temps, je souhaiterai pouvoir rajouter en une fois les informations de plusieurs types de déchets qui ont la même valorisation, cf exemple :

Mais depuis que j'ai changé la propriété de ma Listbox2 (fmMultiselectSingle -> fmMultiselectMulti), j'ai l'erreur suivante : Erreur d'éxecution 94 : Utilisation incorrecte de Null -> pour cette ligne "cherche_déchet = UserForm1.ListBox2.Value ". (cf code ci-après)

Private Sub CommandButton1_Click()

Dim i As Integer
Dim L As Integer
Dim match  As Integer
Dim cherche_catDéchet As String
Dim cherche_déchet As String

Application.ScreenUpdating = False

'on vérifie si toutes les étapes sont sélectionnées
If ListBox1.ListIndex = -1 Or ListBox2.ListIndex = -1 Or ComboBox2.Value = Empty Then
MsgBox ("Vous avez manqué une étape "), vbOKOnly
Exit Sub
End If

'Message de vérification
If MsgBox("Etes-vous certain de vouloir ajouter ces valeurs ?", vbYesNo, "Demande de confirmation") = vbYes Then

    Set Ws = Worksheets("BDDR")
    L = Ws.Range("A" & Rows.Count).End(xlUp).Row + 1

    'On définit la valeur des variables
    cherche_catDéchet = UserForm1.ListBox1.Value
    cherche_déchet = UserForm1.ListBox2.Value

    'Ajouter données consommations
    Ws.Activate

    For i = 1 To L
        If Cells(i, 1) = cherche_catDéchet And Cells(i, 2) = cherche_déchet Then
            match = i
        End If
    Next

    'Si ligne créée
    If match <> 0 Then

    Cells(match, 3).Value = Me.ComboBox2.Value
    Cells(match, 4).Value = Me.ComboBox1.Value
    Cells(match, 5).Value = Me.TextBox1.Value

    End If

End If

Application.ScreenUpdating = False
Unload Me
UserForm1.Show

End Sub

... et je ne trouve pas trop comment faire. J'ai compris que la variable n'est plus adaptée car il y a plusieurs lignes et .Value ne correspond plus . Est-ce bien cela ?

J'ai testé d'utiliser .ItemsSelected, mais ça ne doit pas être ça.

Quelqu'un à une idée ? Cf ci-joint une version simplifié du fichier.

Merci pour vos retours et bonne journée !

Bonjour,

Du fait que votre 2ème Listbox est multisélection, votre variable "cherche_déchet" doit devenir un tableau unidimensionnel que vous remplirez ainsi

    Dim cherche_déchet(): cherche_déchet = Array()
    Dim i As Integer, j As Integer

    With UserForm1.ListBox2
        j = 0
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                ReDim Preserve cherche_déchet(j): cherche_déchet(j) = .List(i, 0): j = j + 1
            End If
        Next i
    End With

Après vous pouvez l'utiliser ainsi via ma fonction "InArray" valable pour un tableau à 1 ou 2 dimensions

.......
If Cells(i, 1) = cherche_catDéchet And  InArray(Cells(i, 2), cherche_déchet) Then
......

ci-dessous la fonction à ajouter dans un module

Function InArray(item, tb) As Boolean
    Dim i As Integer, i1 As Integer, i2 As Integer, n As Integer, dimension As Integer

    InArray = False

    '// détermination de la dimension du tableau
    On Error Resume Next
    While Err = 0
        i = i + 1
        n = UBound(tb, i)
    Wend
    On Error GoTo 0
    dimension = i - 1

    '// traitement selon la dimension du tableau
    Select Case dimension
        Case 0
            Exit Function

        Case 1
            For i = LBound(tb) To UBound(tb)
                If tb(i) = item Then InArray = True: Exit Function
            Next i

        Case 2
            For i1 = LBound(tb, 1) To UBound(tb, 1)
                For i2 = LBound(tb, 2) To UBound(tb, 2)
                    If tb(i1, i2) = item Then InArray = True: Exit Function
                Next i2
            Next i1

        Case Else
            MsgBox "dimension du tableau > 2": Exit Function
    End Select

End Function

Bonjour thev,

Merci, merci pour toutes ces informations ! Je n'aurai sincèrement pas pu trouver ça toute seule...

Je n'ai plus de message d'erreur maintenant, ce qui est vachement chouette. Le petit hic, c'est que les informations (valorisation / prestataire collecte et commentaire) ne s'enregistrent que pour le dernier item que j'ai sélectionné (dans ma sélection multiple). Avez-vous un avis ? Si non, ce n'est pas grave.

Bonne journée,

Bonjour,

Ce code est plus simple et vous permet de tenir compte de la multisélection

    
    'Ajouter données consommations
    Ws.Activate

    For i = 1 To L
        If Cells(i, 1) = cherche_catDéchet And InArray(Cells(i, 2), cherche_déchet) Then
            Cells(i, 3).Value = Me.ComboBox2.Value
            Cells(i, 4).Value = Me.ComboBox1.Value
            Cells(i, 5).Value = Me.TextBox1.Value
        End If
    Next

    Application.ScreenUpdating = False
    Unload Me
    UserForm1.Show

Bonjour et mille mercis !

Tout fonctionne :)