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
| =VBA' https://www.ablebits.com/office-addins-blog/excel-data-validation-regex/
' https://www.ablebits.com/office-addins-blog/regex-match-excel/#regexpmatch-function
' https://learn.microsoft.com/fr-fr/dotnet/standard/base-types/regular-expression-language-quick-reference
Option Explicit
'---------------------------------------------------------------------------------------
Public Function EstValide() As Variant
'---------------------------------------------------------------------------------------
' Vérifie la validation d'une saisie dans une cellule en utilisant la technique
' des expressions régulières. Pour cela on va utiliser la "Validation des données" classique
' mais en utisant une formule qui fait référence à un nom qui fait lui même référence à une
' fonction. Le Modèle de l'expression régulière sera enregistré dans le message de saisie.
' En plus il est possible d'indiquer un format à appliquer à la saisie. Dans ce cas il
' faut l'enregistrer dans le titre du message de saisie (sans les guillemets).
'---------------------------------------------------------------------------------------
' Exemple:
' Dans le gestionnaire des noms créez "Controle_Validation" qui fait référence à "=EstValide()"
' Et dans la validation (Données/validation des données):
' - la case "Ignorer si vide" doit être décochée,
' - la formule personnalisée doit contenir "=Controle_Validation",
' - le titre peut contenir le format de restitution (pour les chaînes),
' - le message de saisie doit contenir le Modèle (de l'expression régulière ou personnalisé),
' - puis décochez "Quand la cellule est sélectionnée".
'---------------------------------------------------------------------------------------
' Remarques:
' J'ai prévu des modèles personnalisés: pour limité la saisie à une valeur numérique il faut
' enregistrer le modèle "IsNumeric". Pour préciser une valeur Minimale et Maximale alors
' enregistrez le modèle "IsNumeric: ValeurMini ; ValeurMaxi". Exemple: "IsNumeric: -99.99 ; 99.99"
' Pour la saisie d'un mail enregistrez "Mail".
' Pour la saisie d'un mot de passe enregistrez "Password". (règle = 8 caractères minimum dont une
' lettre, un chiffre, un caractère spécial.
' Pour faire référence à une cellule nommée: enregistrez "Name=" suivi du nom de la cellule.
' Pour utiliser l'opérateur LIKE: enregistrez "Like=" suivi de la règle.
' LIKE est beaucoup moins puissant que les expressions régulières mais plus simple à comprendre
' et peut être utilisé sur des règles simples de longueur fixe.
' Vous pouvez compléter par d'autres modèles...
' Quatre formats sont disponibles (vous pouvez en inventer d'autres):
' ">>" : met la première lettre en majuscule (Proper) et le reste en minuscule.
' ">" : met tout en majuscule
' "<" : met tout en mininuscule.
' "n" : où n est entre 0 et 15 pour arrondi au nombre de décimales si le modèle est "IsNumeric"
'---------------------------------------------------------------------------------------
Dim Modele As String
Dim MonFormat As String
' Par défaut la fonction renvoie FAUX:
EstValide = False
' Récupère le modèle de l'expression régulière enregistré dans le message de saisie
' de "Données/validation des données/message de saisie" de la cellule:
Modele = ActiveCell.Validation.InputMessage
' Récupère le format à appliquer à la saisie enregistré dans le titre
' de "Données/validation des données/message de saisie" de la cellule:
MonFormat = ActiveCell.Validation.InputTitle
' S'il faut faire référence à une cellule:
If Left(UCase(Modele), 5) = "NAME=" Then
Modele = Replace(Modele, "Name=", "", , , vbTextCompare)
Modele = Range(Modele).Value
End If
' Suivant le modèle indiqué:
Select Case True
Case Modele = "": EstValide = True
Case Left(UCase(Modele), 9) = "ISNUMERIC"
Dim v
Modele = Replace(Modele, ".", ",")
Modele = Replace(Modele, " ", "")
Modele = Replace(Modele, ":", ";")
v = Split(Modele, ";")
If IsNumeric(ActiveCell.Value) = True Then
If MonFormat <> "" Then ActiveCell.Value = Round(ActiveCell.Value, val(MonFormat))
If UBound(v) = 0 Then
EstValide = True
Else
If ActiveCell.Value >= CDec(v(1)) And ActiveCell.Value <= CDec(v(2)) Then EstValide = True
End If
End If
Case UCase(Modele) = "MAIL": EstValide = RegExpMatch(ActiveCell, "^[\w\.\-]+@[A-Za-z0-9]+[A-Za-z0-9\.\-]*[A-Za-z0-9]+\.[A-Za-z]{2,24}$")
Case UCase(Modele) = "PASSWORD": EstValide = RegExpMatch(ActiveCell, "^(?=.*[A-Za-z])(?=.*\d)(?=.*[@$!%*#?&_-])[A-Za-z\d@$!%*#?&_-]{8,}$")
Case Left(UCase(Modele), 5) = "LIKE=": EstValide = ActiveCell.Value Like Mid(Modele, 6)
Case Else: EstValide = RegExpMatch(ActiveCell, Modele)
End Select
' Gestion du format (pour les chaînes):
If MonFormat <> "" Then
DoEvents
Dim M
M = ActiveCell.Value
ActiveCell.Value = EstValide
If ActiveCell.Value = True Then
Select Case MonFormat
Case ">>": M = Application.Proper(M)
Case ">": M = UCase(M)
Case "<": M = LCase(M)
End Select
End If
ActiveCell.Value = M
End If
End Function
'---------------------------------------------------------------------------------------
Private Function RegExpMatch(Input_Range As Range, Pattern As String, Optional Match_Case As Boolean = True) As Variant
'---------------------------------------------------------------------------------------
Dim RegEx
On Error GoTo ErrHandl
RegExpMatch = False
Set RegEx = CreateObject("VBScript.RegExp")
RegEx.Pattern = Pattern
RegEx.Global = True
RegEx.MultiLine = True
RegEx.Ignorecase = Not Match_Case
RegExpMatch = RegEx.test(Input_Range.Value)
Exit Function
ErrHandl:
RegExpMatch = CVErr(xlErrValue)
End Function
'---------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------- |
Sélection de caractère dans une cellule
Répondre avec citation
et si celle-ci est pertinente pensez à voter 
Partager