Concept d'une variable a valeur multiple

**jpvba** · 06/04/2017, 22h07

Bonjour a vous,

J'ai une subroutine permettant de valider les données d'un fichier Excel, si les champs requis sont conformes a un logiciel auquel j'importe les données. Parfois les données que je traite on des erreurs (mauvaises information demandé complétés, mauvaises interprétation de l'utilisateur) et je corrige celles-ci en les identifiant d'une couleurs différente le "font" et l'"interior" afin de les rendre plus visibles. (j'utilise police rouge, remplissage jaune)

Si j'exécute ma sub de validation, je demande d'identifié les erreurs, champs obligatoires manquant, trop long, mauvais type de donné dans une couleur différente (font =3 et interior = 34). Si tout est correct, ou si l'erreur est corrigé, la cellule deviens en blanc écriture noir (font = 1 et interior = 2)

Au lieu de remettre blanc et écriture noir, je voudrais que la cellule sois colorer au "font" et "interior" de la couleur de départ, ainsi les erreurs corrigers ne seraient plus écrasé par le font noir et écriture blanc.

Donc a la fin du processus la cellule ayant une écriture rouge reste rouge et celle ayant une écriture noir reste noir.

Voici une partie du code illustrant ce que je fais présentement

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
'si la longueur de la provinciale courte est plus grand que 100, le texte est en rouge sur fond bleu
 
            If Len(Cells(x + 1, [prov_court_travail].Column)) > 100 Then
                compteur = compteur + 1
                With Cells(x + 1, [prov_court_travail].Column)
                .Font.ColorIndex = 3
                .Interior.ColorIndex = 34
                End With
            Else
                With Cells(x + 1, [prov_court_travail].Column)
                .Font.ColorIndex = 1
                .Interior.ColorIndex = 2
                End With
            End If
 
 
'si la provinciale courte est vide on inscrit ??? et on met en rouge sur fond bleu
 
            If IsEmpty(Cells(x + 1, [prov_court_travail].Column)) Then
                compteur = compteur + 1
                With Cells(x + 1, [prov_court_travail].Column)
                .value = "???"
                .Font.ColorIndex = 3
                .Interior.ColorIndex = 34
                End With
            Else
                With Cells(x + 1, [prov_court_travail].Column)
                .Font.ColorIndex = 1
                .Interior.ColorIndex = 2
                End With
            End If
 
 
'si on a toujours une descripton provinciale courte = ??? ou plus grande que 100 caractères on maintien la couleur rouge sur fond bleu
 
            If Cells(x + 1, [prov_court_travail].Column) = "???" Or Len(Cells(x + 1, 4)) > 100 Then
                compteur = compteur + 1
                With Cells(x + 1, [prov_court_travail].Column)
                .Font.ColorIndex = 3
                .Interior.ColorIndex = 34
                End With
            End If

encore mille fois pour votre aide / commentaires !!!

**jpvba** · 07/07/2017, 14h32

Est-ce que vous savez si c'Est quelque chose de faisable ou c'est trop complexe ???

merci

**mjpmjp** · 08/07/2017, 00h24

bonjour,
il te faut un repaire de couleur -> indication de la couleur d'origine

une indication peut être :
si toute la colonne est verte...
si une couleur en fonction du format...

une mesure extrême :
à la façon d'un log ,
tu notes les cellules à modifier et la couleur : [A2] et [2_34]
pour remettre la couleur tu recherche A2 et tu as tes couleurs 2 et 34
(tu efface la ligne)

@+JP

**eriiic** · 08/07/2017, 01h07

Bonjour,

tu pourrais mettre des n° d'erreurs en commentaire et les supprimer au fur et à mesure de leur correction.
En sortie à toi de mettre la couleur en fonction de ce qu'il reste comme erreurs.
eric

**mjpmjp** · 08/07/2017, 08h59

bonjour,
oui, c'est çà... tu mets les codes couleur en commentaire !!!
@+JP

**jpvba** · 10/07/2017, 15h42

Un gros merci pour la piste de solution !!!

amicalement

JP

**jpvba** · 27/07/2017, 16h58

J'ai fais quelque test de mon coté en copiant le format dans une cellule dédié pour chacune des colonnes en question. Par exemple la colonne chocolat a un miroir appeler couleur_chocolat.

Je me bute toujours au meme probleme i.e. la copie des nouvelles couleurs lors de la ré-exécution de la validation. Si j'exécute la sub une fois tout fonctionne a merveille. La seconde fois, étant donné quelle copie le format, bref elle écrase le contenu antérieur.

Je vais essayé tout bêtement en ajoutant un if si le tout pourra réglé le probleme

encore merci

**Philippe Tulliez** · 27/07/2017, 17h45

Bonjour,
Si j'ai bien compris ta question, tu veux tester une plage de cellule et détecter des erreurs ou anomalies et placer une couleur à ces cellules.
Si c'est le cas, voici une proposition utilisant des constantes énumérées (de 1 à X) et un Select Case True
Tu prévois une plage d'une colonne où en ligne 1 de cette plage, tu place la couleur intérieur que tu souhaites rétablir (par exemple "Aucun remplissage", en ligne 2 et suivantes tu places la couleur intérieure souhaitée pour cette erreur.
Pour l'exemple, la plage à contrôler est A1:A500 de la feuille nommée Feuil1 et la plage contenant les couleurs de F1 à F4 de la même feuille (A toi de choisir éventuellement une autre feuille du même classeur ou d'un autre
Code Exemple avec trois types de contrôle (Cellule vide, non numérique et trop long)

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
Option Explicit
Enum ErrorList
 EstVide = 1
 TropLong = 2
 PasNumeric = 3
End Enum
Sub test()
 Dim c As Range, rng As Range, rngColor As Range, ColorNumber As Byte
 With ThisWorkbook.Worksheets("Feuil1")
  Set rng = .Range("A2:A500")
  Set rngColor = .Range("F1:F4")
 End With
 For Each c In rng
  Select Case True
   Case Len(c) = 0: ColorNumber = ErrorList.EstVide
   Case Len(c) > 10: ColorNumber = ErrorList.TropLong
   Case Not IsNumeric(c): ColorNumber = ErrorList.PasNumeric
   Case Else: ColorNumber = 0
  End Select
  '
  c.Interior.Color = rngColor.Cells(ColorNumber + 1, 1).Interior.Color
  ' 
 Next c
End Sub

**jpvba** · 27/07/2017, 19h22

Bonjour Philippe,

Effectivement je tente a identifier des anomalies selon des critères précis en mettant les cellules ayant un ou des erreurs dans une font.colorindex = 3 et interior.colorindex = 34. Une fois le ou les correctifs apportés, je voudrais lorsque je ré-exécute la sub, les cellules ayant eu des erreurs (devenu font 3 et interior 34) reprennent leur font et interior de départ avant la première exécution de la sub.

Ce qui est le plus "tricky", c'est que le numero du "font" ou de "interior" peut différé d'une cellule ayant un erreur.

Ce que l'on m'a suggéré et que je trouve hyper logique est de copier le format des cellules dans une autre cellules et de récupéré l'info une fois terminer.

Ce qui me cause des embuches c'Est lorsque j'exécute la validation une seconde fois apres bien sur corriger l'erreur, le font et interior copier est remplacer par le 3 et 34. Donc je perds la valeur du font et interior de depart.

en espérant ayant été un peu plus précis dans mes explications !!!

en vous remerciant

**jpvba** · 27/07/2017, 21h36

Avec les if ca semble bien fonctionné

Si je prends mon exemple de départ

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
'si la longueur de la provinciale courte est plus grand que 100, le texte est en rouge sur fond bleu
 
            If Len(Cells(x + 1, [prov_court_travail].Column)) > 100 Then
                compteur = compteur + 1
 
                If Cells(x + 1, [prov_court_travail].Column).Font.ColorIndex <> 3 And _
                   Cells(x + 1, [prov_court_travail].Column).Interior.ColorIndex <> 34 Then
 
                   Cells(x + 1, [prov_court_travail].Column).Copy
                   Cells(x + 1, [couleur_prov_court_travail].Column).PasteSpecial (xlPasteFormats)
 
 
                    With Cells(x + 1, [prov_court_travail].Column)
                        .Font.ColorIndex = 3
                        .Interior.ColorIndex = 34
                    End With
                End If
            Else
 
              If Cells(x + 1, [prov_court_travail].Column).Font.ColorIndex <> 3 And _
                 Cells(x + 1, [prov_court_travail].Column).Interior.ColorIndex <> 34 Then
 
                 Cells(x + 1, [prov_court_travail].Column).Copy
                 Cells(x + 1, [couleur_prov_court_travail].Column).PasteSpecial (xlPasteFormats)
              End If
 
            End If
 
'si la provinciale courte est vide on inscrit ??? et on met en rouge sur fond bleu
 
            If IsEmpty(Cells(x + 1, [prov_court_travail].Column)) Then
                compteur = compteur + 1
 
                With Cells(x + 1, [prov_court_travail].Column)
                    .value = "???"
                    .Font.ColorIndex = 3
                    .Interior.ColorIndex = 34
                End With
            Else
 
                If Cells(x + 1, [prov_court_travail].Column).Font.ColorIndex <> 3 And _
                 Cells(x + 1, [prov_court_travail].Column).Interior.ColorIndex <> 34 Then
 
                 Cells(x + 1, [prov_court_travail].Column).Copy
                 Cells(x + 1, [couleur_prov_court_travail].Column).PasteSpecial (xlPasteFormats)
 
                End If
 
            End If
 
 
 
'si on a toujours une descripton provinciale courte = ??? ou plus grande que 100 caractères on maintien la couleur rouge sur fond bleu
 
            If Cells(x + 1, [prov_court_travail].Column) = "???" Or Len(Cells(x + 1, [prov_court_travail].Column)) > 100 Then
                compteur = compteur + 1
 
                With Cells(x + 1, [prov_court_travail].Column)
                .Font.ColorIndex = 3
                .Interior.ColorIndex = 34
                End With
 
             Else
 
                Cells(x + 1, [couleur_prov_court_travail].Column).Copy
                Cells(x + 1, [prov_court_travail].Column).PasteSpecial (xlPasteFormats)
 
            End If

**Philippe Tulliez** · 28/07/2017, 07h41

Bonjour,

Effectivement je tente a identifier des anomalies selon des critères précis en mettant les cellules ayant un ou des erreurs dans une font.colorindex = 3 et interior.colorindex = 34. Une fois le ou les correctifs apportés, je voudrais lorsque je ré-exécute la sub, les cellules ayant eu des erreurs (devenu font 3 et interior 34) reprennent leur font et interior de départ avant la première exécution de la sub.

Et bien mis à part le fait que je n'ai prévu que la mise en couleur de la cellule et pas la fonte mais il suffit d'ajouter une ligne

Code :

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

c.Font.Color = rngColor.Cells(ColorNumber + 1, 1).Font.Color

Après correction de l'anomalie, il suffit de relancer la procédure pour qu'il place la couleur intérieure et la police dans le format souhaité (Cellule 1 de la plage F1:F4)

Dans l'exemple proposé, il y a la possibilité de définir une couleur par type d'anomalie.

Concept d'une variable a valeur multiple

Macros et VBA Excel

Discussions similaires

Partager

Partager