Discussion :

[andymion]

Bonsoir,
Je me retrouve avec un lèger problème dans mon code.

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
 
Option Explicit
Public Const BaseDeDonnees = "C:\Documents and Settings\david\Bureau\EXPLOITATION"
 
Public Function toto2(Equipe As String) As String
On Error GoTo Err_toto2
 
Dim res As DAO.Recordset
Dim SQL As String
Dim TableauControle()
Dim i%, j%
Dim varExiste As String
 
'Selectionne les services du projet
SQL = "SELECT libmission FROM [T_Données] WHERE  nomtour='" & Equipe & "'AND typetravail = 'CDT'  AND libmission IS NOT NULL ORDER BY libmission ASC"
i = 1
varExiste = "non"
Set res = CurrentDb.OpenRecordset(SQL)
ReDim Preserve TableauControle(1)
'Concatene les différents enregistrements
While Not res.EOF
If i = 1 Then
    TableauControle(1) = res.Fields(0).Value
Else
    For j = 1 To i - 1
        If TableauControle(j) = res.Fields(0).Value Then
            varExiste = "oui"
            Exit For
        End If
    Next j
End If
If varExiste = "non" Then
    TableauControle(i) = res.Fields(0).Value
    toto2 = toto2 & res.Fields(0).Value & " - "
Else
    varExiste = "non"
End If
 
res.MoveNext
i = i + 1
ReDim Preserve TableauControle(i)
Wend
'Enleve le dernier espace et le tiret
toto2 = Left(toto2, Len(toto2) - 2)
'libere la mémoire
Set res = Nothing
 
Exit_toto2:
 
    Exit Function
 
Err_toto2:
    MsgBox Err.Description
    Resume Exit_toto2
End Function

Lorsque je change le type travail CDT par SCO, ça ne marche plus.
Si vous avez une solution, merci de m'apporter votre aide car je démarre tout juste avec ACCESS.

Code :

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

1
2
3
4
5
6
Selectionne les services du projet
SQL = "SELECT libmission FROM [T_Données] WHERE  nomtour='" & Equipe & "'AND typetravail = 'CDT'  AND libmission IS NOT NULL ORDER BY libmission ASC"
i = 1
varExiste = "non"
Set res = CurrentDb.OpenRecordset(SQL)
ReDim Preserve TableauControle(1)

Au besoin, je joins mon fichier access http://www.cijoint.fr/cjlink.php?fil...cijd2kHhgr.zip
Merci, david

[Tofalu]

Y a t'il des données qui vérifie la condition dans la table ?

[andymion]

Bonjour,
non je ne crois pas.
J'avais récupéré ce code dans un tuto et ne l'avait que peu adapté par méconnaissance du VBA.
J'ai trouvé une solution alternative à mon problème. J'obtiens CDT et SCO mais je ne sais si c'est trés propre.

Code :

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

1
2
3
4
5
6
'Selectionne les services du projet
SQL = "SELECT libmission FROM [T_Données] WHERE  nomtour='" & Equipe & "'AND ((typetravail = 'CDT') OR (typetravail='SCO'))   AND libmission IS NOT NULL ORDER BY libmission ASC"
i = 1
varExiste = "non"
Set res = CurrentDb.OpenRecordset(SQL)
ReDim Preserve TableauControle(1)

Dis moi ce que tu en penses.
Merci de votre aide

[olive_tp]

OK... j'ai parcouru le code, le contenu de ta base... c'est effectivement pas très propre...

Si j'ai bien compris, ton code fait une concaténation de données en prenant comme argument d'entrée "Equipe". Il y a cependant des cas où, pour une équipe donnée il n'y a pas de résultat à la requête:

Code :

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

SQL = "SELECT libmission FROM [T_Données] WHERE  nomtour='" & Equipe & "'AND typetravail = 'SCO'  AND libmission IS NOT NULL ORDER BY libmission ASC"

Dans ce cas, toto2 n'est jamais traité (il reste NULL). Et tu appliques dessus la fonction Left qui ne peut pas traiter la variable toto2 - étant donné que toto2 est NULL.

D'autre part, tu as fait une petite erreur de copier/coller: il manque un espace entre un " ' " et le mot "AND".

Corrigé, le code devient:

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
Public Function toto2(Equipe As String) As String
On Error GoTo Err_toto2
 
Dim res As DAO.Recordset
Dim SQL As String
Dim TableauControle()
Dim i%, j%
Dim varExiste As String
 
'par défaut, on met toto2 = ""
toto2 = ""
 
'Selectionne les services du projet
SQL = "SELECT libmission FROM [T_Données] WHERE  nomtour='" & Equipe & "' AND typetravail = 'CDT'  AND libmission IS NOT NULL ORDER BY libmission ASC"
i = 1
varExiste = "non"
Set res = CurrentDb.OpenRecordset(SQL)
ReDim Preserve TableauControle(1)
'Concatene les différents enregistrements
While Not res.EOF
If i = 1 Then
    TableauControle(1) = res.Fields(0).Value
Else
    For j = 1 To i - 1
        If TableauControle(j) = res.Fields(0).Value Then
            varExiste = "oui"
            Exit For
        End If
    Next j
End If
If varExiste = "non" Then
    TableauControle(i) = res.Fields(0).Value
    toto2 = toto2 & res.Fields(0).Value & " - "
Else
    varExiste = "non"
End If
 
res.MoveNext
i = i + 1
ReDim Preserve TableauControle(i)
Wend
'Enleve le dernier espace et le tiret si toto2 n'est pas vide
If toto2 <> "" Then toto2 = Left(toto2, Len(toto2) - 2)
'ferme res et libère l'objet
res.Close
Set res = Nothing
 
Exit_toto2:
 
    Exit Function
 
Err_toto2:
    MsgBox Err.Description
    Resume Exit_toto2
End Function

et là ça fonctionne (normalement... )!