IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Test auto de cellules


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre confirmé Avatar de Paloma
    Profil pro
    Inscrit en
    Juin 2006
    Messages
    228
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juin 2006
    Messages : 228
    Par défaut 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 : 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
    ''--------------------------------------------------------------------------
    ''    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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 : 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
    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 : 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
    '+------------------------------------------------------------------------+
    '|
    '| 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.

  2. #2
    Membre confirmé
    Profil pro
    Inscrit en
    Octobre 2010
    Messages
    97
    Détails du profil
    Informations personnelles :
    Âge : 45
    Localisation : France

    Informations forums :
    Inscription : Octobre 2010
    Messages : 97
    Par défaut
    Tu peux peut être créer un tableau dynamique de "string" ou "variant", qui stockerait l'adresse des cellules éronnées à chaque fois qu'une erreur se produit. Ensuite tu n'as plus qu'à relire le tableau et faire ta mise en forme en conséquence.

Discussions similaires

  1. faire des teste sur une cellule editable
    Par minanoun dans le forum Composants
    Réponses: 0
    Dernier message: 07/06/2009, 11h27
  2. Test si la cellule sélectionnée est vide
    Par Dapangma dans le forum Macros et VBA Excel
    Réponses: 7
    Dernier message: 24/08/2008, 12h00
  3. Importation & remplissage auto des cellules
    Par Chikatilo dans le forum Macros et VBA Excel
    Réponses: 8
    Dernier message: 18/06/2008, 10h56
  4. Erreur lors du test d'un cellule
    Par Godzestla dans le forum Macros et VBA Excel
    Réponses: 6
    Dernier message: 20/05/2008, 12h55
  5. [VB][Excel]test la dernière cellule pleine d'une feuille
    Par Mugette dans le forum Macros et VBA Excel
    Réponses: 6
    Dernier message: 22/09/2005, 13h25

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo