Modification code pour comparer minuscule/majuscule, accent/sans accent

**jgresse1025** · 03/04/2015, 12h23

Bonjour,

J'ai un problème pour avec mon code
J'ai les deux requète suivante qui vienne chercher dans dans un fichier des info que je demande dans des combobox
Cependant, lorsque ce n'est pas ecrit pareil (l'un avec accent, l'autre sans/ l'un en majuscule, l'autre en minuscule) ça ne le prend pas en compte

Je voulais savoir comment modifier le code suivant pour que ça le prenne en compte

Code :

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

1
2
3
 
Sql = "Select * from [2015$A6:J10000] where Format([Lancé le],'yyyy-mm-dd') >= '" & Format(Workbooks("ERP.xlsm").Sheets("Suivi").Range("D5"), "yyyy-mm-dd") & "' AND [Txx-xxxxx]='" & Me.ComboBox1.Text & "' and [Référence pièce Timex]='" & Me.ComboBox2.Text & "' and ([Description]='" & Sans_accent(Me.ComboBox3.Text) & "' or Description ='" & Me.ComboBox3.Text & "') "
Sql1 = "Select * from [2015$A6:J10000] where Format([Demandé le],'yyyy-mm-dd') >= '" & Format(Workbooks("ERP.xlsm").Sheets("Suivi").Range("D5"), "yyyy-mm-dd") & "' AND [Txx-xxxxx]='" & Me.ComboBox1.Text & "' and [Référence pièce Timex]='" & Me.ComboBox2.Text & "' and ([Description]='" & Sans_accent(Me.ComboBox3.Text) & "' or Description='" & Me.ComboBox3.Text & " ') "

Pou Sans_accent, on m'a donné ce 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
Function Sans_accent(Chaine As String) As String  ' R. Dezan + Michel Pierron || adaptée et commentée par D. IBKA
 
' remplacement des caractères accentués par leur équivalent sans accent
 
 Dim ListeDesAccents As String
 Dim ListeSansAccent As String
 Dim i As Integer
 Dim u As Integer
 
 ' on va utiliser deux listes de correspondance (avec et sans accent)
 ' chaque caractère accentué a une position définie dans la liste des accents
 ' son équivalent sans accent a la même position dans la liste sans accent
 
 ListeDesAccents = "ÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿ"
 ListeSansAccent = "AAAAAAEEEEIIIINOOOOOUUUUYaaaaaaeeeeiiiionooooouuuuyy"
 
 
 ' pour chaque caractère de la chaine testée
 For i = 1 To Len(Chaine)
 
    ' on cherche si le caractère fait partie de la liste des caractères accentués
    u = InStr(1, ListeDesAccents, Mid(Chaine, i, 1), 0)
 
    ' si c'est le cas, on le remplace par son équivalent non accentué
    If u Then
        Mid(Chaine, i, 1) = Mid(ListeSansAccent, u, 1)
    End If
 
 Next i
 
 ' on retrouve à la fin : une chaîne convertie sans les accents
 Sans_accent = Chaine
 
End Function

Cependant si dans la combobox il y a pas d'accent mais que dans description il y en a un, ça ne le prend pas en compte
J'ai essayer

Code :

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

Sans_accent([Description])='" & Sans_accent(Me.ComboBox3.Text) &

mais ça ne marche pas. Ca me met une erreur

Merci d'avance pour votre aide
Julien

Invité · 03/04/2015, 13h36

Bonjour,
j'ai trouvé ça: http://www.developpez.net/forums/d10...s/#post6029385

**joe.levrai** · 03/04/2015, 13h44

Bonjour,

tu ne peux pas utiliser Sans_Accent pour l'appliquer directement dans le champs

Si je dis pas de bêtises, ta BDD est dans un classeur Excel ?

Dans ce cas, il faudrait plutôt (si ta BDD n'est pas trop grosse), utiliser un tableau sous VBA : tu y charges chaque ligne de ta BDD
ensuite tu vas pouvoir manipuler Sans_Accent dans une boucle qui va parcourir chaque ligne de ton tableau pour trouver les entrées répondant à tes critères.

c'est pas ma spécialité, et d'autres membres t'apporteront plus rapidement une solution efficace si tu n'as pas l'habitude

**jgresse1025** · 03/04/2015, 13h49

Merci pour vos réponses.

Et sinon pour la gestion de la comparaison minuscule/majuscule

Je ne vois pas comment faire.

Invité · 03/04/2015, 13h56

tant que l'on ce trouve coté vba il est possible de supprimer les accents et le lien que j'ai trouvé le démontre car j'ai fait des test et ça marche; si le problème ce trouve coté BDD vue qu'il s'agit d'Excel il n'y à pas de solution; à moins mais c'est pas sur de replacer le accents par des # qui veut dire caractère inconnu! where txt='T#l#vision' je suis même pas sure que ce soit de # c'est peut-être des @ where txt='T@l@vision' si non where txt like 'T%l%vision' fonctionne mais les repose approchante risque d'être prise en compte ('TéléProvision')!

**jgresse1025** · 03/04/2015, 14h02

Bah en fait le problème vient du coté BDD
Si dans ma base de donnée, il y a un accent à ce que je recherche et que dans ce que je sélectionne il y a pas d'accent, ça déconne
Pas possible de contourner le problème ?

**joe.levrai** · 03/04/2015, 14h04

Pour la comparaison majuscule/minuscule, tu peux encore une fois manipuler la chaine avec UCase et LCase
Sinon, va voir l'aide du côté de "Option Compare Text"

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
 
 
Sub Demo
Dim ChaineMaj as String
Dim ChaineMin as String
 
ChaineMaj = "MAJUSCULE"
ChaineMin = "minuscule"
 
' résultat : majuscule
Debug.print LCase(ChaineMaj)
 
'résulte : MINUSCULE
Debug.print UCase(ChaineMin)
 
Exit sub

Pour régler définitivement le problème, et si c'est possible, je te conseille :

- tu converti toute ta BDD pour supprimer les accents
- tu n'as plus qu'à gérer le cas de la valeur du combobox, qui est possible avec la fonction Sans_Accent que je t'ai suggéré il y a quelques jour

Pour info complète : cette fonction Sans_Accent existe sous diverses version, mais d'un fonctionnement identique. D'ailleurs, le lien de rdurupt présente une autre version de cette fonction
De mon côté, j'ai simplement récupéré la fonction qui disposait de variables un peu obscures et pas claire. J'ai renommé les variables, j'ai réagencé un peu le code et je l'ai entièrement commenté.

Invité · 03/04/2015, 14h11

mais tu peux remettre ta base en phase!

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
Private Declare Function FoldString Lib "kernel32.dll" Alias _
        "FoldStringA" (ByVal dwMapFlags As Long, ByVal lpSrcStr As Long, _
        ByVal cchSrc As Long, ByVal lpDestStr As Long, ByVal cchdest As Long) As Long
 
 
Sub test()
Sql1 = "Select [Description] from [2015$A6:J10000]"
Set rs = CreateObject("adodb.recordset")
rs.Open Sql, cnx
While rs.EOF = False
    rs("Description") = OteAccents("" & rs("Description"))
    rs.Update
    rs.movenext
Wend
 End Sub
Function OteAccents(ByVal str As String) As String
 
    Dim i As Integer
    OteAccents = Space(Len(str))
 
    For i = 0 To (Len(str) - 1) * 2 Step 2
        FoldString &H40, StrPtr(str) + i, 1, StrPtr(OteAccents) + i, 1
    Next i
 
End Function

**jgresse1025** · 03/04/2015, 14h18

J'ai trouvé ça sur la FAQ :
Il faut créer une fonction personnalisée qui remplace la lettre accentuée par la même mais sans l'accent.

Dans un module :

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
 
Public Function sansAccent(ByVal Chaine As String, EnMajuscule As Boolean) As String
Chaine = LCase(Chaine)
Chaine = Replace(Chaine, Chr(232), "e")
Chaine = Replace(Chaine, Chr(233), "e")
Chaine = Replace(Chaine, Chr(234), "e")
Chaine = Replace(Chaine, Chr(235), "e")
Chaine = Replace(Chaine, Chr(249), "u")
Chaine = Replace(Chaine, Chr(250), "u")
Chaine = Replace(Chaine, Chr(251), "u")
Chaine = Replace(Chaine, Chr(242), "o")
Chaine = Replace(Chaine, Chr(244), "o")
Chaine = Replace(Chaine, Chr(254), "o")
Chaine = Replace(Chaine, Chr(255), "y")
Chaine = Replace(Chaine, Chr(224), "a")
Chaine = Replace(Chaine, Chr(225), "a")
Chaine = Replace(Chaine, Chr(226), "a")
Chaine = Replace(Chaine, Chr(238), "i")
Chaine = Replace(Chaine, Chr(239), "i")
chaine = Replace(chaine, Chr(244), "o")
If EnMajuscule Then Chaine = UCase(Chaine)
sansAccent = Chaine
End Function

Et la requête :

Code :

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

1
2
 
SELECT * FROM MaTable WHERE SansAccent(MonChamp,True)=sansaccent("élève",true)

J'ai essayer ce code en écrivant ça :

Code :

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

Sql = "Select * from [2015$A6:J10000] where Format([Lancé le],'yyyy-mm-dd') >= '" & Format(Workbooks("ERP.xlsm").Sheets("Suivi").Range("D5"), "yyyy-mm-dd") & "' AND [Txx-xxxxx]='" & Me.ComboBox1.Text & "' and [Référence pièce Timex]='" & Me.ComboBox2.Text & "' and (sansAccent([Description],True)='" & sansAccent(Me.ComboBox3.Text, True) & "' or [Description]='" & Me.ComboBox3.Text & "') "

Mais ça me met l'erreur: Fonction sansAccent non définie dans l'expression

Vous voyez pourquoi ?

**mercatog** · 03/04/2015, 14h24

Pour l'utilisation de l'api FoldString, attention quand même aux caractères particuliers, dont notamment le ç et le œ ...

Invité · 03/04/2015, 14h31

Code :

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

SELECT * FROM MaTable WHERE SansAccent(MonChamp,True)=sansaccent("élève",true)

WHERE SansAccent(MonChamp,True) sous entant une procédure tocké mais dans Excel ça n'existe pas.

pour répondre à mercatog, si la modification s'opère des 2 coté ça ne pose pas de problème mais ça implique certaines faute d’orthographes acceptable ou pas!
si li s'agit de colorier la cellule vert;orange et rouge alors!!

**jgresse1025** · 03/04/2015, 14h44

Envoyé par rdurupt

mais tu peux remettre ta base en phase!

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
Private Declare Function FoldString Lib "kernel32.dll" Alias _
        "FoldStringA" (ByVal dwMapFlags As Long, ByVal lpSrcStr As Long, _
        ByVal cchSrc As Long, ByVal lpDestStr As Long, ByVal cchdest As Long) As Long
 
 
Sub test()
Sql1 = "Select [Description] from [2015$A6:J10000]"
Set rs = CreateObject("adodb.recordset")
rs.Open Sql, cnx
While rs.EOF = False
    rs("Description") = OteAccents("" & rs("Description"))
    rs.Update
    rs.movenext
Wend
 End Sub
Function OteAccents(ByVal str As String) As String
 
    Dim i As Integer
    OteAccents = Space(Len(str))
 
    For i = 0 To (Len(str) - 1) * 2 Step 2
        FoldString &H40, StrPtr(str) + i, 1, StrPtr(OteAccents) + i, 1
    Next i
 
End Function

Ce code, dans quelle endroit je doit le mettre
Et surtout comment faire le sub test avec ma requète original. Car je ne cherche pas que [Description] dans ma requête original

merci de votre aide

Invité · 03/04/2015, 14h51

ça sur la première ligne de ton module en dessous d'option explicite si tu la!

Code :

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

1
2
3
Private Declare Function FoldString Lib "kernel32.dll" Alias _
        "FoldStringA" (ByVal dwMapFlags As Long, ByVal lpSrcStr As Long, _
        ByVal cchSrc As Long, ByVal lpDestStr As Long, ByVal cchdest As Long) As Long

ça dans ta sub en dessous de ta connexion cnx.open

Code :

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

1
2
3
4
5
6
7
8
Sql1 = "Select [Description] from [2015$A6:J10000]"
Set rs = CreateObject("adodb.recordset")
rs.Open Sql, cnx
While rs.EOF = False
    rs("Description") = OteAccents("" & rs("Description"))
    rs.Update
    rs.movenext
Wend

ça en dernière ligne de ton module!

Code :

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

1
2
3
4
5
6
7
8
9
10
Function OteAccents(ByVal str As String) As String
 
    Dim i As Integer
    OteAccents = Space(Len(str))
 
    For i = 0 To (Len(str) - 1) * 2 Step 2
        FoldString &H40, StrPtr(str) + i, 1, StrPtr(OteAccents) + i, 1
    Next i
 
End Function

**jgresse1025** · 03/04/2015, 14h58

Donc par exemple pour ce bout de code que j'ai

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
Sql = "Select * from [2015$A6:J10000] where Format([Lancé le],'yyyy-mm-dd') >= '" & Format(Workbooks("ERP.xlsm").Sheets("Suivi").Range("D5"), "yyyy-mm-dd") & "' AND [Txx-xxxxx]='" & Me.ComboBox1.Text & "' and [Référence pièce Timex]='" & Me.ComboBox2.Text & "' and ([Description]='" & Sans_accent(Me.ComboBox3.Text) & "' or [Description]='" & Me.ComboBox3.Text & "') "
Sql1 = "Select * from [2015$A6:J10000] where Format([Demandé le],'yyyy-mm-dd') >= '" & Format(Workbooks("ERP.xlsm").Sheets("Suivi").Range("D5"), "yyyy-mm-dd") & "' AND [Txx-xxxxx]='" & Me.ComboBox1.Text & "' and [Référence pièce Timex]='" & Me.ComboBox2.Text & "' and ([Description]='" & Sans_accent(Me.ComboBox3.Text) & "' or [Description]='" & Me.ComboBox3.Text & "') "
Sql2 = "Select * from [Suivi$B8:B30] where [Nom de l'étape]='Fil'"
Sql3 = "Select * from [Suivi$B8:B30] where [Nom de l'étape]='Sodick'"
Sql4 = "Select * from [Suivi$B8:B30] where [Nom de l'étape]='V22'"
 
For l = 9 To 23
If l = 9 Then
 
    If Rech.Cells(l, 2).Text Like "Fil" Or Rech.Cells(l, 2).Text Like "Drill 20" Then
    Set mrs = CreateObject("ADODB.Recordset")
    mrs.Open Sql1, Conn
        If mrs.EOF = True Then
            Rech.Range("C" & l).Interior.ColorIndex = 3
        ElseIf Trim("" & mrs("Fait").Value <> "") Then
             Rech.Range("C" & l).Interior.ColorIndex = 10
        Else
             Rech.Range("C" & l).Interior.ColorIndex = 46
             Rech.Range("C" & l).Value = "En attente"
        End If
        n = n + 1
        mrs.Close
        Set mrs = Nothing
        End If

Il faut que j'insère

Code :

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

1
2
3
4
5
6
7
8
9
 
Sql1 = "Select [Description] from [2015$A6:J10000]"
Set rs = CreateObject("adodb.recordset")
rs.Open Sql, cnx
While rs.EOF = False
    rs("Description") = OteAccents("" & rs("Description"))
    rs.Update
    rs.movenext
Wend

Après ça :

Code :

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

1
2
3
4
 
If Rech.Cells(l, 2).Text Like "Fil" Or Rech.Cells(l, 2).Text Like "Drill 20" Then
    Set mrs = CreateObject("ADODB.Recordset")
    mrs.Open Sql1, Conn

C'est ça ?

En gros, j'ai tout ce 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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
 
Dim Conn As Object
Dim Conn1 As Object
Dim Conn2 As Object
Dim Conn3 As Object
Set Conn = CreateObject("ADODB.Connection")
Set Conn1 = CreateObject("ADODB.Connection")
Set Conn2 = CreateObject("ADODB.Connection")
Set Conn3 = CreateObject("ADODB.Connection")
Dim mrs As Object
Dim mrs1 As Object
Dim mrs2 As Object
Set mrs = CreateObject("ADODB.Recordset")
Set mrs1 = CreateObject("ADODB.Recordset")
Set mrs2 = CreateObject("ADODB.Recordset")
Dim mrs3 As Object
Set mrs3 = CreateObject("ADODB.Recordset")
Dim mrs4 As Object
Set mrs4 = CreateObject("ADODB.Recordset")
Dim mrs5 As Object
Set mrs5 = CreateObject("ADODB.Recordset")
Dim sconnect As String
Dim sconnect1 As String
Dim sconnect2 As String
Dim sconnect3 As String
sconnect = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=C:\Users\mto\Desktop\Suivi_Mc_FIL2.xlsx;HDR=Yes';"
sconnect1 = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=C:\Users\mto\Desktop\Suivi_enfoncage.xls;HDR=Yes';"
sconnect2 = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=C:\Users\mto\Desktop\Suivi_Mc_V22.xls;HDR=Yes';"
sconnect3 = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=C:\Users\mto\Desktop\ERP.xlsm;HDR=Yes';"
Conn.Open sconnect
Conn1.Open sconnect1
Conn2.Open sconnect2
Conn3.Open sconnect3
Dim Sql As String
Dim Sql1 As String
Dim Sql2 As String
Dim Sql3 As String
Dim Sql4 As String
Dim Nb, Nb1, Nb2, Nb3
Dim r As Integer
Dim n As Integer
Dim p As Integer
n = 0
r = 0
p = 0
Sql = "Select * from [2015$A6:J10000] where Format([Lancé le],'yyyy-mm-dd') >= '" & Format(Workbooks("ERP.xlsm").Sheets("Suivi").Range("D5"), "yyyy-mm-dd") & "' AND [Txx-xxxxx]='" & Me.ComboBox1.Text & "' and [Référence pièce Timex]='" & Me.ComboBox2.Text & "' and ([Description]='" & Sans_accent(Me.ComboBox3.Text) & "' or [Description]='" & Me.ComboBox3.Text & "') "
Sql1 = "Select * from [2015$A6:J10000] where Format([Demandé le],'yyyy-mm-dd') >= '" & Format(Workbooks("ERP.xlsm").Sheets("Suivi").Range("D5"), "yyyy-mm-dd") & "' AND [Txx-xxxxx]='" & Me.ComboBox1.Text & "' and [Référence pièce Timex]='" & Me.ComboBox2.Text & "' and ([Description]='" & Sans_accent(Me.ComboBox3.Text) & "' or [Description]='" & Me.ComboBox3.Text & "') "
Sql2 = "Select * from [Suivi$B8:B30] where [Nom de l'étape]='Fil'"
Sql3 = "Select * from [Suivi$B8:B30] where [Nom de l'étape]='Sodick'"
Sql4 = "Select * from [Suivi$B8:B30] where [Nom de l'étape]='V22'"
 
For l = 9 To 23
If l = 9 Then
 
    If Rech.Cells(l, 2).Text Like "Fil" Or Rech.Cells(l, 2).Text Like "Drill 20" Then
    Set mrs = CreateObject("ADODB.Recordset")
    mrs.Open Sql1, Conn
        If mrs.EOF = True Then
            Rech.Range("C" & l).Interior.ColorIndex = 3
        ElseIf Trim("" & mrs("Fait").Value <> "") Then
             Rech.Range("C" & l).Interior.ColorIndex = 10
        Else
             Rech.Range("C" & l).Interior.ColorIndex = 46
             Rech.Range("C" & l).Value = "En attente"
        End If
        n = n + 1
        mrs.Close
        Set mrs = Nothing
        End If
 
    If Rech.Cells(l, 2).Text Like "Sodick" Then
    Set mrs1 = CreateObject("ADODB.Recordset")
    mrs1.Open Sql, Conn1
        If mrs1.EOF = True Then
            Rech.Range("C" & l).Interior.ColorIndex = 3
        ElseIf Trim("" & mrs1("Fait").Value <> "") Then
             Rech.Range("C" & l).Interior.ColorIndex = 10
        Else
             Rech.Range("C" & l).Interior.ColorIndex = 46
             Rech.Range("C" & l).Value = "En attente"
        End If
        r = r + 1
        mrs1.Close
        Set mrs1 = Nothing
    End If
 
    If Rech.Cells(l, 2).Text Like "V22" Then
    Set mrs2 = CreateObject("ADODB.Recordset")
    mrs2.Open Sql, Conn2
        If mrs2.EOF = True Then
            Rech.Range("C" & l).Interior.ColorIndex = 3
        ElseIf Trim("" & mrs2("Fait").Value <> "") Then
             Rech.Range("C" & l).Interior.ColorIndex = 10
        Else
             Rech.Range("C" & l).Interior.ColorIndex = 46
             Rech.Range("C" & l).Value = "En attente"
        End If
        p = p + 1
        mrs2.Close
        Set mrs2 = Nothing
    End If
 
 ElseIf Rech.Range("C" & l - 1).Interior.ColorIndex <> 10 Then
 Else
    If Rech.Cells(l, 2).Text Like "Fil" Then
     Set mrs = CreateObject("ADODB.Recordset")
     Set mrs3 = CreateObject("ADODB.Recordset")
     mrs.Open Sql1, Conn
     mrs3.Open Sql2, Conn3
        If mrs.EOF = True Then
            Rech.Range("C" & l).Interior.ColorIndex = 46
        Else
         Nb = RetournNb(mrs, ("[Demandé le]<>Null"))
         Nb1 = RetournNb(mrs3, "[Nom de l'étape]<>NULL")
        'MsgBox (UBound(Nb, 2))
         'MsgBox (n)
       ' If TypeName(Nb) <> "Boolean" Then 'si il y a une occurrence ce n'est pas boolean
             If UBound(Nb, 2) < n Then
             Rech.Range("C" & l).Interior.ColorIndex = 46
             ElseIf TypeName(Nb(9, n)) <> "NULL" Then
                Rech.Range("C" & l).Interior.ColorIndex = 10
             Else
                Rech.Range("C" & l).Interior.ColorIndex = 46
                Rech.Range("C" & l).Value = "En attente"
             'Else
              '  Rech.Range("C" & l).Interior.ColorIndex = 46
        ' End If
         End If
        n = n + 1
        End If
        mrs.Close
        mrs3.Close
        Set mrs = Nothing
        Set mrs3 = Nothing
    End If
    'End If
 
 
    If Rech.Cells(l, 2).Text Like "Sodick" Then
     Set mrs1 = CreateObject("ADODB.Recordset")
     Set mrs3 = CreateObject("ADODB.Recordset")
     mrs1.Open Sql, Conn1
     mrs3.Open Sql3, Conn3
        If mrs1.EOF = True Then
            Rech.Range("C" & l).Interior.ColorIndex = 46
        Else
         Nb = RetournNb(mrs1, "[Lancé le]<>Null")
        Nb2 = RetournNb(mrs3, "[Nom de l'étape]<>NULL")
        'If TypeName(Nb) <> "Boolean" Then 'si il y a une occurrence ce n'est pas boolean
             If UBound(Nb, 2) < r Then
             Rech.Range("C" & l).Interior.ColorIndex = 46
             ElseIf TypeName(Nb(9, r)) <> "NULL" Then
              Rech.Range("C" & l).Interior.ColorIndex = 10
             Else
               Rech.Range("C" & l).Interior.ColorIndex = 46
               Rech.Range("C" & l).Value = "En attente"
 
 
         'Else
          ' Rech.Range("C" & l).Interior.ColorIndex = 46
 
        'End If
        End If
         r = r + 1
        End If
        mrs1.Close
        mrs3.Close
        Set mrs1 = Nothing
        Set mrs3 = Nothing
    End If
    'End If
 
     If Rech.Cells(l, 2).Text Like "V22" Then
     Set mrs2 = CreateObject("ADODB.Recordset")
     Set mrs3 = CreateObject("ADODB.Recordset")
     mrs2.Open Sql, Conn2
     mrs3.Open Sql4, Conn3
        If mrs2.EOF = True Then
            Rech.Range("C" & l).Interior.ColorIndex = 46
        Else
         Nb3 = RetournNb(mrs3, "[Nom de l'étape]<>NULL")
         Nb = RetournNb(mrs2, "[Lancé le]<>Null")
         'MsgBox (UBound(Nb, 2))
        ' MsgBox (p)
       ' If TypeName(Nb) <> "Null" Then 'si il y a une occurrence ce n'est pas boolean
 
 
             If UBound(Nb, 2) < p Then
             Rech.Range("C" & l).Interior.ColorIndex = 46
             ElseIf TypeName(Nb(9, p)) <> "Null" Then
              Rech.Range("C" & l).Interior.ColorIndex = 10
             Else
               Rech.Range("C" & l).Interior.ColorIndex = 46
               Rech.Range("C" & l).Value = "En attente"
            End If
 
        ' Else
          ' Rech.Range("C" & l).Interior.ColorIndex = 46
        End If
        p = p + 1
        'End If
        mrs2.Close
        mrs3.Close
        Set mrs2 = Nothing
        Set mrs3 = Nothing
    End If
    'End If
 
 
End If
 
Next l
Conn.Close
Conn1.Close
Conn2.Close
 Set Conn = Nothing
 Set Conn1 = Nothing
 Set Conn2 = Nothing

Il faut que je créer de nouveau numéro de SQL et de nouvelle connexion ?

Invité · 03/04/2015, 15h09

il faut l'insérer là dessous, et le faire pour chaque connexion concernées!

Code :

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

1
2
3
4
Conn.Open sconnect
Conn1.Open sconnect1
Conn2.Open sconnect2
Conn3.Open sconnect3

**jgresse1025** · 03/04/2015, 15h13

Et il faut que je crée de nouveau Sql et mrs ?

Invité · 03/04/2015, 15h18

oui

**jgresse1025** · 03/04/2015, 15h19

Et après, les mrs et SQL, Est-ce qu'il faut que je les rappeles dans la suite de mon code ?

Invité · 03/04/2015, 15h22

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
 
Conn.Open sconnect
Conn1.Open sconnect1
Conn2.Open sconnect2
Conn3.Open sconnect3
 
Sql = "Select [Description] from [2015$A6:J10000]"
Set rs = CreateObject("adodb.recordset")
rs.Open Sql, Conn
While rs.EOF = False
    rs("Description") = OteAccents("" & rs("Description"))
    rs.Update
    rs.movenext
Wend
rs.close
set rs=nothing
set rs = CreateObject("adodb.recordset")
rs.Open Sql, Conn1
While rs.EOF = False
    rs("Description") = OteAccents("" & rs("Description"))
    rs.Update
    rs.movenext
Wend
rs.close
set rs=nothing

**jgresse1025** · 03/04/2015, 15h25

le fait que des recordset est le meme nom, ça ne gène pas ?

Modification code pour comparer minuscule/majuscule, accent/sans accent

Macros et VBA Excel

Discussions similaires

Partager

Partager