Test auto de cellules

Bonjour,

Il y a quelques temps, j'ai posté sur ce même forum un problème que j'ai eu du mal à résoudre (ce qui n'aurait pas été possible sans vous ;)).

Ma cellule, testée automatiquement, ne doit pouvoir contenir que deux chiffres ou deux chiffres et une lettres (excepté la lettre "i", "I" et "o", "O").

Code principale:

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
''--------------------------------------------------------------------------
''    Automatic checks and replacements during capture
''
''--------------------------------------------------------------------------
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim msg_err, Cel As Range
 
   If (Target.Column <> 4 And Target.Column <> 54) And Target.Count = 1 Then Exit Sub
    Application.EnableEvents = False
    For Each Cel In Target
        Select Case Cel.Column
        Case 4
           'Traitement colonne 4
            If Cel <> "" Then
                msg_err = TestCellule(Cel.Value)
                If msg_err <> "" Then
                    MsgBox msg_err, vbCritical + vbOKOnly, "Data : Error"
                    Cel.ClearContents
                    Cel.Select
                    msg_e999rr = ""
                Else
                    Cel = UCase(Cel)
                End If
             End If
        Case 54
           'Traitement colonne 54
           Cel = UCase(Cel)
        End Select
    Next Cel
    Application.EnableEvents = True
End Sub

Fonction test de ma cellule :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Function TestCellule(Buffer As String) As String
Dim msg_err
        Buffer = UCase(Buffer) 'éviter le test Minuscule
        Select Case Len(Buffer)
            Case 2
                If Not (Buffer Like "##") Then msg_err = "Please enter 2 Digits or 2 Digits and 1 Char in upper case (except 'i' or 'I' and 'o' or 'O')."
            Case 3
                If Not Left(Buffer, 2) Like "##" Or _
                 Buffer Like "##[i]" Or Buffer Like "##[I]" Or Buffer Like "##[o]" Or Buffer Like "##[O]" Or Buffer Like "###" Then msg_err = "Please enter 2 Digits or 2 Digits and 1 Char in upper case (except 'i' or 'I' and 'o' or 'O')."
            Case Else
                msg_err = "Please enter 2 Digits or 2 Digits and 1 Char in upper case (except 'i' or 'I' and 'o' or 'O')."
        End Select
    TestCellule = msg_err
End Function

Cependant, j'aurai besoin de faire ce même type de controle lorsque l'utilisateur clique sur un bouton (qui par ailleurs exécute déjà plusieurs types de controles pour chaque colonne et chaque cellule).

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
Sub InitCheck(nb_line)
 
 
    Call MustBeANumber("SubATA", nb_line, -1, 1, 9999)
    Call MustBeANumber("ATA Chapter", nb_line, 1, 1, 99)
 
    'Call MustBeANumber("SUB-ATA", nb_line, 2, 1, 99)
'============================================================================================================
' Control SUB-ATA with specific Value :
'
 
Dim msg_err, Cel As Range
 
Cel = Cells(nb_line, 4).Value
 
            If Cel <> "" Then
                msg_err = TestCellule(Cel.Value)
                    If msg_err <> "" Then
                        MsgBox msg_err, vbCritical + vbOKOnly, "Data : Error"
                        Cel.ClearContents
                        Cel.Select
                        msg_e999rr = ""
                    Else
                        Cel = UCase(Cel)
                End If
             End If
 
    Application.EnableEvents = True
'End Sub
' end of the specific control ===============================================================================
 
 
 
    Call MustBeANumber("Sequence", nb_line, 3, 1, 9999)
    Call MinMaxLength("Circuit Letters", nb_line, 4, "2", "2")
    Call MustBeANumber("Suffix 7", nb_line, 5, 0, 9)
    Call MustBeANumber("Suffix 8", nb_line, 6, 0, 9)
....    
 
End Sub

Et j'aimerai utiliser aussi la même fonction "test de ma cellule".

Comment faire pour que si il y a une erreur dans une cellule, elle soit entouré de rouge?

J'ai un bout de code qui me dit à la fin le nombre de cellule qui sont en erreur, devrais-je le modifier pour prendre en compte ce controle?

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
'+------------------------------------------------------------------------+
'|
'| Initialize Cells Validation
'|
'+------------------------------------------------------------------------+
 
    InitCheck (nb_line)
 
 
    'This function go through all cells and check if they respect the validation control
    ' that have just been set above.
    ' If not, a red circle is drawn around the cell.
    ActiveSheet.CircleInvalid
 
    last_column = Worksheets(Sheets("Management").Name).Range("B7").Value
 
    nb_invalid = 0
    nb_valid = 0
 
    ' Check all lines of the column from the line (i_Line =)
    For i_line = 6 To nb_line
            For j_column = 1 To (last_column + 2)
 
                If (ActiveWorkbook.ActiveSheet.Cells(i_line, j_column).Validation.Value = True) Then
                    nb_valid = nb_valid + 1
                Else
                    nb_invalid = nb_invalid + 1
                End If
            Next
    Next
 
    Range("A6").Select
 
    If ((nb_required = 0) And (nb_duplicate = 0) And (nb_invalid = 0)) Then
        Call MsgBox("Validation Successfull !", vbInformation, "Check Result")
    Else
        Call MsgBox("Validation Error !" _
           & "  Nb missing values = " & nb_required _
           & "  Nb incorrect values = " & nb_invalid _
           , vbCritical, "Check Result")
    End If
 
ClearValidations
 
End Sub  'GeneralCheck

Merci d'avance pour vos lumières.
:)