Problème de champs dans Code VBA

Version imprimable

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

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

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

04/11/2009, 09h03
Tofalu

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

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:

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

on va essayer de t'aider

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:

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:

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... ;))!