Problème avec la multiselection

Version imprimable

Bonjour, J'ai crée une listbox avec la propriété 'sélection multiple' à simple.
Elle fonctionne bien mais lorsque je click sur 'Enregistrer', toutes
les valeurs ne s'enregistrent pas.
Par exemple si je sélectionne une valeur X et une autre Y, il
enregistre que l'une des deux.
Je ne sait pas comment gérer ça.

Voici mon code

Merci d'avance
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Private Sub Enr_Click() On Error GoTo Erreur rst.MoveLast rst.AddNew rst.Fields("Num_tireur") = tireur_D.Column(0) rst.Fields("NUM_ETANG") = etang_D.Column(0) rst.Fields("DATED") = Date_D rst.Update [Form_Demande]!DEMANDER.Visible = True [Form_Demande]!DEMANDER.Requery [Form_Demande]!autre_demande.Visible = True Exit_Enr_Click: Exit Sub Erreur: MsgBox Err.Description Resume Exit_Enr_Click End Sub

30/03/2006, 17h00
SfJ5Rpw8

pas trés clair ton code.. il nous manque des infos... de quelle liste tu parle ... il sont ou X et Y ?
30/03/2006, 17h09
do1404

J'ai une table où se trouve des chasseurs, une autre où se trouve des étangs é une 3eme où se trouve des demandes de tir.
Je doit gérer les demandes de tir sur les étangs par des chasseurs.
J'ai une listbox pour les chasseurs et une autre pour les étangs. Ces deux listes ont la propriété multiselection d'activée car je doit pouvoir sélectionner plusieurs étangs et plusieurs chasseurs. J'ai d'autre part un bouton Enregistrer qui enregistre le numéro de chasseur et le numéro d'étang dans la table Demande. Mais ce bouton ne gère pas la multiselection.
Exemple : si je sélectionne un chasseur X et chasseur Y dans la listbox chasseur et je sélectionne l'étang Z.Seul le chasseur X et l'étang Z sont enregistrer mais je ne retrouve pas le chasseur Y que j'ai pourtant sélectionné.

J'espère être plus clair, sinon dites moi ce qui ne l'est pas.

tiens essai cela j'ai pas pu tester mais cela nde doit pas être loin :

Code:

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
Private Sub Enr_Click()
Dim i As Integer 'Index dans tireurs
Dim J As Integer 'Index dans etangs
 
On Error GoTo Erreur
 
For i = 0 To tireur_D.ListCount - 1
   If tireur_D.Selected(i) Then
       For J = 0 To etang_D.ListCount - 1
            If etang_D.Selected(i) Then
                rst.MoveLast
                rst.AddNew
                rst.Fields("Num_tireur") = tireur_D.List(i)
                rst.Fields("NUM_ETANG") = etang_D.List(J)
                rst.Fields("DATED") = Date_D
                rst.Update
            End If
       Next ' .. fin boucle parcours etangs
    End If
Next ' .. fin boucle parcours tireur
[Form_Demande]!DEMANDER.Visible = True
[Form_Demande]!DEMANDER.Requery
[Form_Demande]!autre_demande.Visible = True
 
Exit_Enr_Click:
    Exit Sub
 
Erreur:
    MsgBox Err.Description
    Resume Exit_Enr_Click
End Sub

31/03/2006, 09h47
do1404

Merci pour la logique, c'est ce qu'il me fallait.

C'est bon ça marche comme je veux. Je joint mon code si quelqu'un à le même problème que moi. Merci beaucoup pour ton aide bbil :D

Code:

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
Private Sub Enregistrer_Click()
    Dim i As Integer
    Dim J As Integer
    On Error GoTo Erreur
    Var1 = NomListBox1.ListCount
    Var2= NomListBox2.ListCount
    i = 0
    J = 0
    While i < Var1
        If NomListBox1.Selected(i) Then
            While J < Var2
                If NomListBox2.Selected(J) Then
                    rst.AddNew
                    rst.Fields("Champ1") = NomListBox1.Column(N°Colonne, i)
                    rst.Fields("Champ2T") = NomListBox2.Column(N°Colonne, J)
                    rst.Fields("Champ3") = TextBox1
                    rst.Update
                    J = J + 1
                Else: J = J + 1
                End If
            Wend
            i = i + 1
        J = 0
        Else: i = i + 1
        End If
    Wend
    [Form_NomForm1]!NomForm2.Visible = True
    [Form_NomForm1]!NomForm2.Requery
    [Form_NomForm1]!Btn.Visible = True
 
Exit_Enr_Click:
    Exit Sub
 
Erreur:
    MsgBox Err.Description
    Resume Exit_Enr_Click
End Sub