[EXCEL] Validation des données saisies - nouvelle Question :-)

Version imprimable

Voir 40 message(s) de cette discussion en une page

28/11/2006, 11h47
ouskel'n'or

C'est normal : i = 1
Donc DataString(i) = "L"
Supprime (i) dans DataString

Code:

InString(i) = Filter(DataString, strValue, True, vbTextCompare)

Je te l'ai fait mettre car je ne comprenais pas l'erreur, juste pour voir ;) Peut-être qu'on peut passer un tableau...
28/11/2006, 11h54
ouskel'n'or
Si tu déclares InString en tableau, c'est sans doute que tu dois récupérer un tableau.
Auquel cas, Tu supprimes tout ce que je t'ai dit

Citation:

i = i + 1
Redim InString(i)

et tu mets bien

Code:

InString = Filter(DataString, strValue, True, vbTextCompare)

Je comprends mieux ton
Code:

1 2 3 For i = 0 To UBound(InString) Debug.Print InString(i) Next i
Désolé mais les erreurs successives m'ont fait chercher ailleurs les causes :oops:
Mais bon, un conseil : évite de nommer un module du même nom qu'une propriété et, d'une manière générale, qu'un mot mot clé ;)
28/11/2006, 13h28
Paloma

Merci ouskel'n'or

Merci beaucoup,
Franchement je mérite une balle alors si tu veux te défouler sur moi maintenant tu peux :mouarf: lol

Non vraiement, chuis désolé.
Je modifie le code et je vous tiens au courant.
Cordialement,
Paloma

Bon me revoilou

Parfait, ce n'est pas trop mal.

Donc j'ai placé ce code dans un module sous forme de fonction que l'on peu appeler pour vérifier la saisie :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub ButAdd_Click()
    strValue = InputBox("Please enter a value to consider to translate the package", "Add filter")
    If strValue = "NULL" Or strValue = "" Then
    MsgBox "You must enter a not empty value!", vbCritical, "!STOP!"
    Else
    ListBoxFilters.AddItem UCase(strValue)
    ButGenerate.Visible = True
    End If
strSignleValue = strValue
Call chkPrograms(strSingleValue)
 
End Sub

Et la fonction dans le module "ChkProAircraft" :

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
Public Function chkPrograms(strSingleValue As String) As String
'Programs Descriptions ---------------------------------------------
 
        Dim DataString(10) As String
            Dim InString() As String
            Dim i As Integer
            Dim strActive As String
 
        'Remplissage du tableau qui va être testé
            DataString(0) = "R" ' AC_WBY_A300
            DataString(1) = "L" ' AC_SA_A318
            DataString(2) = "L" ' AC_SA_A319
            DataString(3) = "L" ' AC_SA_A319CJ
            DataString(4) = "L" ' AC_SA_A320
            DataString(5) = "L" 'AC_SA_A321
            DataString(6) = "N" ' AC_LR_A330
            DataString(7) = "N" ' AC_LR_A340
            DataString(8) = "F" ' AC_LR_A380
            DataString(9) = "N" ' AC_XWB_A350
            DataString(10) = "M" ' AC_Military_A400M
 
            '"DataString" est le tableau dans lequel doit être effectué la recherche.
            '"str" est la chaîne à rechercher.
            'La fonction Filter renvoie le tableau "InString" contenant les éléments
            'qui répondent aux critères de la recherche.
 
            InString = Filter(DataString, strSingleValue, True, vbTextCompare)
            strActive = DataString(i)
 
            'Boucle sur le tableau afin de visualiser les éléments
            'qui répondent aux critères de recherche.
            For i = 0 To UBound(InString)
                Debug.Print InString(i)
            Next i
 
                If strSingleValue = strActive Then
                Else
                MsgBox "You enter an invalid Aircraft Programs Letter (" & strActive & ")", vbCritical, "Airbus Policy"
                End If
 
End Function

Donc, j'ai pas mal de question : :roll:

En fait, comment passer un contrôle vers la fonction que pour les lettres, on économisera sur les chiffres un certain temps de traitement... ?

Puis, je pense que je devrais directement dans le form, contrôler si dans la saisie, il existe le ";" sinon je refuse la saisie avec un bo message donc la je vais regarder comment faire.

Enfin, pour la chaîne de gauche (avant le ; ), je vérifie qu'elle existe bien dans ma feuille "Work Files", et là aussi, il faut que je cherche....

Donc si vous pensez qu'il y a plus simple ou que je m'égare vous pouvez m'avertir s'il vous plait.

Merci @ plus

Paloma

le ;

Bon voilà j'ai trouvé pour tester la présence du caractère ";".
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 Private Sub ButAdd_Click() strValue = InputBox("Please enter a value to consider to translate the package", "Add filter") If strValue = "NULL" Or strValue = "" Then MsgBox "You must enter a not empty value!", vbCritical, "!STOP!" Else 'vérification que le séparateur ";" existe ------------------------------------------------------------- If InStr(1, strValue, ";") = 0 Then boolSeparator = False MsgBox "You forget ; char separator between old value and new value!", vbCritical, "!STOP!" Else boolSeparator = True End If 'Vérification que la chaine avant le ";" existe bien dans la feuille Excel "WorkFiles" ---------------- If boolSeparator = True Then ListBoxFilters.AddItem UCase(strValue) ButGenerate.Visible = True Else MsgBox "error value!", vbCritical, "!STOP!" End If End If strSingleValue = strValue Call chkPrograms(strSingleValue) End Sub
Donc, je continue mes investigations ....

Je pense rebaptiser le boolseparator en boolvalidity comme ça, je test le ;
si ok boolvalidity = true sinon stop! + message 1

donc si true, je teste la chaine avant le ; dans le classeur "Work Files"
si ok boolvalidity = true (en fait reste true) sinon stop! + message 2

Enfin, je regarde si il existe un caractère de type lettre à droite du ";" et si c'est vrai, je compare avec ma fonction chkPrograms.
si ok boolvalidity = true (en fait reste true) sinon stop et fin ! + message 3

Si tout est ok, j'ajoute la ligne dans la liste des filtres.

Qu'en pensez-vous?

Paloma

Nouvelle question :-)

Bon ok j'ai avancé.

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
Private Sub ButAdd_Click()
    strValue = InputBox("Please enter a value to consider to translate the package", "Add filter")
    If strValue = "NULL" Or strValue = "" Then
    MsgBox "You must enter a not empty value!", vbCritical, "!STOP!"
    Exit Sub
    Else
    'vérification que le séparateur ";" existe -------------------------------------------------------------
            If InStr(1, strValue, ";") = 0 Then
                boolSeparator = False
                MsgBox "You forget ; char separator between old value and new value!", vbCritical, "!STOP!"
                Exit Sub
                Else
                boolSeparator = True
                End If
 
     'Extraction de la chaine de caractère jusqu'au ";" ---------------------------------------------------
 
            Dim strOldChar As String
            Dim intPosition As Integer
            intPosition = InStr(1, strValue, ";") - 1
            strOldChar = Left(strValue, intPosition)
 
     'Vérification que la chaine avant le ";" existe bien dans la feuille Excel "WorkFiles" ----------------
 
                Sheets("Work files").Select
                Columns("C:C").Select
                Selection.Find(What:=strOldChar, After:=ActiveCell, LookIn:=xlFormulas, _
                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False).Activate
 
'                    Dim boolStringFind As Boolean
'                    boolStringFind = CBool(MatchCase)
'                If boolStringFind = True Then
'                Else
'                End If
 
     If boolSeparator = True Then
        ListBoxFilters.AddItem UCase(strValue)
        ButGenerate.Visible = True
        Else
        MsgBox "error value!", vbCritical, "!STOP!"
        End If
    End If
 
 
 
        strSingleValue = strValue
        Call chkPrograms(strSingleValue)
 
End Sub

J'essaye de vérifier que la chaine strOldChar existe bien dans mon tableau, si vrai alors boolSeparator = true sinon false.

Mais comment je peux à partir d'une recherche passer ma variable de true à false et vice-versa ?

Merci.
@ plus
Paloma

Essaie ça et évite les Select qui allourdissent les procédures et les ralentissent ;)

Code:

1
2
3
4
5
6
Dim ok as booléan
        with Worksheets("Work files").Range("B:B")
            Set Trouvé = .Find(strOldChar, LookIn:=xlValues)
            if  Not Trouvé Is Nothing then ok = true
        end with
        if ok then...

Tu dis

Désolé, j'ai pas tout compris ...

Heuu .... merci ouskel'n'or :lol:

Mais voilà j'ai :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
     'Extraction de la chaine de caractère jusqu'au ";" ---------------------------------------------------
 
            Dim strOldChar As String
            Dim intPosition As Integer
            intPosition = InStr(1, strValue, ";") - 1
            strOldChar = Left(strValue, intPosition)
 
     'Vérification que la chaine avant le ";" existe bien dans la feuille Excel "WorkFiles" ----------------
            Dim boolStringFind As Boolean
 
                With Worksheets("Work files").Range("C:C")
                    Set boolStringFind = .Find(strOldChar, LookIn:=xlValues)
                    boolStringFind = Not boolStringFind Is Nothing
                    Set boolStringFind = Nothing
                End With
            If boolStringFind = Nothing Then
                    MsgBox "Your request value ( " & strOldChar & " ) does not exist in all filename !", vbCritical, "!STOP!"
                    boolvalidity = False
                       Else
                    boolvalidity = True
                End If

ça ne fonctionne pas qu'est-ce que j'oublie ?

Oops ! Corrige ces lignes pour

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Dim ok as booléan
                sheets("Work files").activate
                With Worksheets("Work files").Range("C:C")
                    Set boolStringFind = .Find(strOldChar, LookIn:=xlValues)
                    if Not boolStringFind Is Nothing then ok = True
                    Set boolStringFind = Nothing
                End With
                If not ok Then
                    MsgBox "Your request value ( " & strOldChar & " ) does not exist in all filename !", vbCritical, "!STOP!"
                    boolvalidity = False
                       Else
                    boolvalidity = True
                End If

Là ça risque d'être plus mieux
En fait, boolStringFind contient le mot cherché s'il a été trouvé, ce n'est pas un booléen. Tu dois passer par un booléen intermédiaire, ici ok (que tu peux remplacer partout par boolvalidity... si tu veux)
Une autre chose, ta feuille doit être activée pour effectuer une recherche avec Find. Au cas où...

A+

NB - J'ai corrigé le code dans le message précédent

ouskel'n'or j' ta'dor ;-)

Super merci, ça fonctionne, bon j'ai moi aussi corrigé un peu le code car j'avais fait une erreur sur le type boolStringFing qui n'est pas un boolean mais un objet d'où le nouveau nom objStringFind ;)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
     'Vérification que la chaine avant le ";" existe bien dans la feuille Excel "WorkFiles" ----------------
            Dim objStringFind
            Dim ok As Boolean
                Sheets("Work files").Activate
                With Worksheets("Work files").Range("C:C")
                    Set objStringFind = .Find(strOldChar, LookIn:=xlValues)
                    If Not objStringFind Is Nothing Then ok = True
                    Set objStringFind = Nothing
                End With
                If Not ok Then
                    MsgBox "Your request value ( " & strOldChar & " ) does not exist in all filename !", vbCritical, "!STOP!"
                    boolvalidity = False
                       Else
                    boolvalidity = True
                End If
                Sheets("Reference File GENERATOR").Activate

Il ne reste plus qu'à vérifier que si le premier caractère après le ";" est une lettre, je regarde qu'il corresponde bien à un avion. :pc:

Puis, je passerais le code complet pour info.

@ plus.
Merci encore
Paloma

:merci:

Voilà j'ai presque fini ...

Bon d'accord j'ai encore un truc qui ne fonctionne pas bien.

Donc dans mon code, il y a trois vérifications sur la saisie :

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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
Private Sub ButAdd_Click()
    strValue = InputBox("Please enter a value to consider to translate the package", "Add filter")
    If strValue = "NULL" Or strValue = "" Then
    MsgBox "You must enter a not empty value!", vbCritical, "!STOP!"
    Exit Sub
    Else
 
'=(1)==================================================================================================================
    'vérification que le séparateur ";" existe -------------------------------------------------------------
            If InStr(1, strValue, ";") = 0 Then
                boolvalidity = False
                MsgBox "You forget ; char separator between old value and new value!", vbCritical, "!STOP!"
                Exit Sub
                Else
                boolvalidity = True
                End If
 
     'Extraction de la chaine de caractère jusqu'au ";" ---------------------------------------------------
 
            Dim strOldChar As String
            Dim intPosition As Integer
            intPosition = InStr(1, strValue, ";") - 1
            strOldChar = Left(strValue, intPosition)
 
'=(2)==================================================================================================================
     'Vérification que la chaine avant le ";" existe bien dans la feuille Excel "WorkFiles" ----------------
            Dim objStringFind
            Dim ok As Boolean
                'Sheets("Work files").Activate
                With Worksheets("Work files").Range("C:C")
                    Set objStringFind = .Find(strOldChar, LookIn:=xlValues)
                    If Not objStringFind Is Nothing Then ok = True
                    Set objStringFind = Nothing
                End With
                If Not ok Then
                    MsgBox "Your request value ( " & strOldChar & " ) does not exist in all filename !", vbCritical, "!STOP!"
                    boolvalidity = False
                       Else
                    boolvalidity = True
                End If
                'Sheets("Reference File GENERATOR").Activate
 
'=(3)==================================================================================================================
    'Extraction du premier caractère après le ";" ----------------------------------------------------------
 
            Dim strAircraftChar As String
            'Dim intPosition As Integer
            intPosition = InStr(1, strValue, ";") + 1
            strAircraftChar = Mid(strValue, intPosition, 1)
 
    'Vérification que ce caractère est bien une Lettre de l'alphabet ---------------------------------------
           Dim intCODE As Integer
           intCODE = Asc(strAircraftChar)
 
            If intCODE < 65 Then
 
            Else
    'Vérification Programme Avion (AIRBUS) -----------------------------------------------------------------
 
        'strSingleValue = strValue
        Call chkPrograms(strAircraftChar)
 
            End If
 
'Ajout du filtre si toutes les condition sont vrai ----------------------------------------------------------
     If boolvalidity = True Then
        ListBoxFilters.AddItem UCase(strValue)
        ButGenerate.Visible = True
        Else
        MsgBox "For to add a new filter, please you must enter a value corresponding to a part of the old file name then a (;) separator and after a value to change the first value you has entered", vbInformation, "Tips for added a new filter :"
        End If
    End If
 
 
End Sub

a partir du :
'=(3)==================================================================================================================
Le problème c'est que, si j'ai bien une lettre après le ";" la fonction chkPrograms est appelée mais elle ne fonctionne pas.

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
Public Function chkPrograms(strSingleValue As String) As String
'Programs Descriptions ---------------------------------------------
 
        Dim DataString(10) As String
            Dim InString() As String
            Dim i As Integer
            Dim strActive As String
 
        'Remplissage du tableau qui va être testé
            DataString(0) = "R" ' AC_WBY_A300
            DataString(1) = "L" ' AC_SA_A318
            DataString(2) = "L" ' AC_SA_A319
            DataString(3) = "L" ' AC_SA_A319CJ
            DataString(4) = "L" ' AC_SA_A320
            DataString(5) = "L" 'AC_SA_A321
            DataString(6) = "N" ' AC_LR_A330
            DataString(7) = "N" ' AC_LR_A340
            DataString(8) = "F" ' AC_LR_A380
            DataString(9) = "N" ' AC_XWB_A350
            DataString(10) = "M" ' AC_Military_A400M
 
            '"DataString" est le tableau dans lequel doit être effectué la recherche.
            '"str" est la chaîne à rechercher.
            'La fonction Filter renvoie le tableau "InString" contenant les éléments
            'qui répondent aux critères de la recherche.
 
            InString = Filter(DataString, strSingleValue, True, vbTextCompare)
            strActive = DataString(i)
 
            'Boucle sur le tableau afin de visualiser les éléments
            'qui répondent aux critères de recherche.
            For i = 0 To UBound(InString)
                Debug.Print InString(i)
            Next i
 
                If strSingleValue = strActive Then
                Else
                MsgBox "You enter an invalid Aircraft Programs Letter (" & strActive & ")", vbCritical, "Airbus Policy"
                End If
 
End Function

Je cherche si la lettre trouvée est bien dans le tableau si ok je ne fais rien, sinon, j'affiche un message d'erreur avec le caractère en question, j'informe que ce n'est pas un caractère valide et je passe ma valeur boolvalidity à false dans la partie principale du programme.

Si quelqu'un peu m'aider à ce sujet.

Bien à vous.
Paloma

29/11/2006, 10h14
SfJ5Rpw8
tiens ton probléme doit venir de la de la façon dont est écrit ton code je pense que tu aura le même résultat en remplaçant
Code:

1 2 strActive = DataString(i]
par

Code:

strActive="R"

puisqu'as l'endroit où tu l'utilise je ne vois pas comment i peu "valoir" une autre valeur que 0 ..?
29/11/2006, 10h44
ouskel'n'or

Je t'ai donné une réponse mais j'ai commis une erreur sur les variables à comparer. Je ne me souviens plus mais que récupères-tu dans InString() ?
A toi ;)
29/11/2006, 11h13
Paloma

Heu ... yes

Bon ok, je m'égare moi aussi de toute façon.
Je pense que je prends mal le problème.

En fait, dans strSingleValue, je récupère une lettre de l'alphabet.

J'aimerais que si cette lettre n'existe pas dans le tableau, ma variable boolvalidity passe à false.

Donc ce que je fais avec InString ne me sert à rien... :marteau:
Donc il faut que je cherche comment comparer ce caractère avec tous ceux de mon tableau.

Donc j'ai presque tout à revoir...

Paloma
29/11/2006, 11h22
ouskel'n'or
Malgré tout, et avant de tout démolir, j'aimerais savoir ce qu'il y a dans InString.
Tu as mis
Code:

1 2 3 For i = 0 To UBound(InString) Debug.Print InString(i) Next i
Qu'est-ca que ça affiche ?
A+
29/11/2006, 11h45
Paloma

Ben ... heu, il m'affiche L :aie:
c'est ce que je saisie, enfin je crois :

M571;L412

Mais si je tape M571;T412, il ne se passe rien ... ou en tout cas je ne vois rien :aie:
29/11/2006, 12h25
ouskel'n'or
Donc, si j'ai bien compris, ce qu'il t'importe, c'est que dans cette chaîne (M571;L412) il y ait bien l'une des lettres de ton tableau DataString(n)
Si ce n'est que ça ton test doit se faire sur ce tableau
Code:

1 2 3 4 5 6 7 For i = 1 to Ubound(InString(i) For j = 1 to 10 ok = Mid(InString(i), 5,1) = DataString(j) if ok then exit for Next j if ok then exit for Nex i
Et ensuite

Code:

if not ok then Message que tu veux

Tu dis

C'est un peu ça.
en fait, je sasie par exemple M571;N412 dans un intBox et je récupère le caractère après le ; ici c'est N.

Puis je parcours le tableau DataString (0) to DataString (10) pour voir si N existe.

Mais j'ai un message d'erreur.
Tableau attendu.

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
'Programs Descriptions ---------------------------------------------
 
        Dim DataString(10) As String
            Dim InString() As String
            Dim i As Integer
            Dim strActive As String
 
        'Remplissage du tableau qui va être testé
            DataString(0) = "R" ' AC_WBY_A300
            DataString(1) = "L" ' AC_SA_A318
            DataString(2) = "L" ' AC_SA_A319
            DataString(3) = "L" ' AC_SA_A319CJ
            DataString(4) = "L" ' AC_SA_A320
            DataString(5) = "L" 'AC_SA_A321
            DataString(6) = "N" ' AC_LR_A330
            DataString(7) = "N" ' AC_LR_A340
            DataString(8) = "F" ' AC_LR_A380
            DataString(9) = "N" ' AC_XWB_A350
            DataString(10) = "M" ' AC_Military_A400M
 
            '"DataString" est le tableau dans lequel doit être effectué la recherche.
            '"str" est la chaîne à rechercher.
            'La fonction Filter renvoie le tableau "InString" contenant les éléments
            'qui répondent aux critères de la recherche.
 
            InString = Filter(DataString, strSingleValue, True, vbTextCompare)
            strActive = DataString(i)
 
            'Boucle sur le tableau afin de visualiser les éléments
            'qui répondent aux critères de recherche.
            For i = 0 To UBound(InString(i))
                Debug.Print InString(i)
            Next i
 
                If strSingleValue = strActive Then
                Else
                MsgBox "You enter an invalid Aircraft Programs Letter (" & strActive & ")", vbCritical, "Airbus Policy"
                End If
 
End Function

Excuse moi ouskel'n'or mais je navigue qu'est-ce que je navigue si se n'est que pour reprendre ta phrase : :mouarf:

Citation:

Tant que tu rames, dis-toi que tu navigues

ben suffit de tester l'"Ubound "pour savoir si ta lettre est dans le tableau

Code:

1
2
3
4
5
6
7
8
9
10
11
12
 
 
 InString = Filter(DataString, strSingleValue, True, vbTextCompare)
 'strActive = DataString(i)
strActive = "R" ' => ça je sais pas à quoi cela sert....?
 
....
If UBound(InString) >= 0 Then
               MsgBox "DEDANS"
               Else
               MsgBox "DEHORS"
            End If

Pour résumer :

Merci encore à vous mon cher bbil et mon cher ouskel'n'or :D
:ccool:
Donc voilà le résultat final qui pourra peut-être servir à quelqu'un.

************* Code de mon bouton "Add" *******************
Ce code ajoute dans une listBox chaque éléments que saisie l'utilisateur.
Il y a trois vérifications sur la chaine saisie.
(1), (2) et (3)

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
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
Option Explicit
Public strPathJob As String
Dim strValue As String
Dim strSingleValue As String
Public boolvalidity As Boolean
 
Private Sub ButAdd_Click()
    strValue = InputBox("Please enter a value to consider to translate the package", "Add filter")
    If strValue = "NULL" Or strValue = "" Then
    MsgBox "You must enter a not empty value!", vbCritical, "!STOP!"
    Exit Sub
    Else
 
'=(1)==================================================================================================================
    'vérification que le séparateur ";" existe -------------------------------------------------------------
            If InStr(1, strValue, ";") = 0 Then
                boolvalidity = False
                MsgBox "You forget ; char separator between old value and new value!", vbCritical, "!STOP!"
                Exit Sub
                Else
                boolvalidity = True
                End If
 
     'Extraction de la chaine de caractère jusqu'au ";" ---------------------------------------------------
 
            Dim strOldChar As String
            Dim intPosition As Integer
            intPosition = InStr(1, strValue, ";") - 1
            strOldChar = Left(strValue, intPosition)
 
'=(2)==================================================================================================================
     'Vérification que la chaine avant le ";" existe bien dans la feuille Excel "WorkFiles" ----------------
            Dim objStringFind
            Dim ok As Boolean
                'Sheets("Work files").Activate
                With Worksheets("Work files").Range("C:C")
                    Set objStringFind = .Find(strOldChar, LookIn:=xlValues)
                    If Not objStringFind Is Nothing Then ok = True
                    Set objStringFind = Nothing
                End With
                If Not ok Then
                    MsgBox "Your request value ( " & strOldChar & " ) does not exist in all filename !", vbCritical, "!STOP!"
                    boolvalidity = False
                    Exit Sub
                       Else
                    boolvalidity = True
                End If
                'Sheets("Reference File GENERATOR").Activate
 
'=(3)==================================================================================================================
    'Extraction du premier caractère après le ";" ----------------------------------------------------------
 
            Dim strAircraftChar As String
            'Dim intPosition As Integer
            intPosition = InStr(1, strValue, ";") + 1
            strAircraftChar = Mid(strValue, intPosition, 1)
 
    'Vérification que ce caractère est bien une Lettre de l'alphabet ---------------------------------------
           Dim intCODE As Integer
           intCODE = Asc(strAircraftChar)
 
            If intCODE < 65 Then
 
            Else
    'Vérification Programme Avion (AIRBUS) -----------------------------------------------------------------
 
        'strSingleValue = strValue
        Call chkPrograms(strAircraftChar)
            End If
    'Que dois-je faire ? -----------------------------------------------------------------------------------
        If boolvalidity = False Then
                Exit Sub
            Else
        End If
 
'Ajout du filtre si toutes les conditions sont vrai ---------------------------------------------------------
     If boolvalidity = True Then
        ListBoxFilters.AddItem UCase(strValue)
        ButGenerate.Visible = True
        Else
        MsgBox "For to add a new filter, please you must enter a value corresponding to a part of the old file name then a (;) separator and after a value to change the first value you has entered", vbInformation, "Tips for added a new filter :"
        End If
    End If
 
 
End Sub

Enfin et merci à vous deux, voici pour la dernière vérification la fonction qui vérifie que le caractère passé dans la fonction existe bien dans le tableau :

********************* Function chkPrograms ******************

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
Public Function chkPrograms(strSingleValue As String) As String
'Programs Descriptions ---------------------------------------------
 
        Dim DataString(10) As String
            Dim InString() As String
            Dim i As Integer
 
        'Remplissage du tableau qui va être testé
            DataString(0) = "R" ' AC_WBY_A300
            DataString(1) = "L" ' AC_SA_A318
            DataString(2) = "L" ' AC_SA_A319
            DataString(3) = "L" ' AC_SA_A319CJ
            DataString(4) = "L" ' AC_SA_A320
            DataString(5) = "L" 'AC_SA_A321
            DataString(6) = "N" ' AC_LR_A330
            DataString(7) = "N" ' AC_LR_A340
            DataString(8) = "F" ' AC_LR_A380
            DataString(9) = "N" ' AC_XWB_A350
            DataString(10) = "M" ' AC_Military_A400M
 
            '"DataString" est le tableau dans lequel doit être effectué la recherche.
            '"str" est la chaîne à rechercher.
            'La fonction Filter renvoie le tableau "InString" contenant les éléments
            'qui répondent aux critères de la recherche.
 
            InString = Filter(DataString, strSingleValue, True, vbTextCompare)
 
            If UBound(InString) >= 0 Then
               frmGenerator.boolvalidity = True
               Else
               MsgBox "You enter an invalid Aircraft Programs Letter (" & strSingleValue & ")", vbCritical, "Airbus Policy"
               frmGenerator.boolvalidity = False
            End If
 
 
End Function

:merci:

@ bientôt
Paloma

Voir 40 message(s) de cette discussion en une page