Contraintes additionnelles

Le
Flac
Bonjour,
Excel 2000
Je voudrais ajouter des contraintes additionnelles à la procédure qui suit.
Le format des cellules de la colonne "F" (la colonne cible) est "Texte".
Je voudrais donc qu'après avoir vérifié que les 16 caractères numériques
inscrits dans la cellule de la colonne "F"
soient valides, la macro vérifie aussi 3 contraintes supplémentaires, soit:

if "le premier caractère de la cellule cible est égal à 4" then
target.offset(0,-2) = "b"
elseif "le premier caractère de la cellule cible est égal à 5" then
target.offset(0,-1) = "b"
elseif "le premier caractère de la cellule est différent de 4 ou 5" then
goto erreur
end if

Espérant que ma requête est bien comprise, je vous remercie d'avance

Flac

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 10 Then
ActiveSheet.Unprotect
Application.EnableEvents = False
On Error GoTo erreur
x = Application.Substitute(Target, "-", "")
If Len(x) = 0 Then
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
Exit Sub
End If
If Len(x) <> 16 Then GoTo erreur
Target = Left(x, 4) & "-" & Mid(x, 5, 4) & "-" & Mid(x, 9, 4) & "-" &
Right(x, 4)
x = x * 1
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
Exit Sub
erreur:
MsgBox Target & Chr(10) & "n'est pas un numéro valide." & Chr(10) &
Chr(10) & "Recommencez.", vbCritical, " NON VALIDE"
Target.Select
Target.ClearContents
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 10 Then
ActiveSheet.Unprotect
Target.NumberFormat = "@"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
End If
End Sub
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Jacky
Le #16751941
Bonjour,

N'y a t-il pas confusion entre Colonne "F" et Target.Column = 10
--
Salutations
JJ


"Flac"
Bonjour,
Excel 2000
Je voudrais ajouter des contraintes additionnelles à la procédure qui
suit.
Le format des cellules de la colonne "F" (la colonne cible) est "Texte".
Je voudrais donc qu'après avoir vérifié que les 16 caractères numériques
inscrits dans la cellule de la colonne "F"
soient valides, la macro vérifie aussi 3 contraintes supplémentaires,
soit:

if "le premier caractère de la cellule cible est égal à 4" then
target.offset(0,-2) = "b"
elseif "le premier caractère de la cellule cible est égal à 5" then
target.offset(0,-1) = "b"
elseif "le premier caractère de la cellule est différent de 4 ou 5" then
goto erreur
end if

Espérant que ma requête est bien comprise, je vous remercie d'avance

Flac

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 10 Then
ActiveSheet.Unprotect
Application.EnableEvents = False
On Error GoTo erreur
x = Application.Substitute(Target, "-", "")
If Len(x) = 0 Then
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
Exit Sub
End If
If Len(x) <> 16 Then GoTo erreur
Target = Left(x, 4) & "-" & Mid(x, 5, 4) & "-" & Mid(x, 9, 4) & "-" &
Right(x, 4)
x = x * 1
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
Exit Sub
erreur:
MsgBox Target & Chr(10) & "n'est pas un numéro valide." & Chr(10) &
Chr(10) & "Recommencez.", vbCritical, " NON VALIDE"
Target.Select
Target.ClearContents
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 10 Then
ActiveSheet.Unprotect
Target.NumberFormat = "@"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
End If
End Sub




Flac
Le #16753061
Bonjour,
Effectivement, il y a confusion. Je voulais parler de la colonne J.

Une erreur bête.

Merci


Flac


"Jacky" uKEuj%
Bonjour,

N'y a t-il pas confusion entre Colonne "F" et Target.Column = 10
--
Salutations
JJ


"Flac"
Bonjour,
Excel 2000
Je voudrais ajouter des contraintes additionnelles à la procédure qui
suit.
Le format des cellules de la colonne "F" (la colonne cible) est "Texte".
Je voudrais donc qu'après avoir vérifié que les 16 caractères numériques
inscrits dans la cellule de la colonne "F"
soient valides, la macro vérifie aussi 3 contraintes supplémentaires,
soit:

if "le premier caractère de la cellule cible est égal à 4" then
target.offset(0,-2) = "b"
elseif "le premier caractère de la cellule cible est égal à 5" then
target.offset(0,-1) = "b"
elseif "le premier caractère de la cellule est différent de 4 ou 5" then
goto erreur
end if

Espérant que ma requête est bien comprise, je vous remercie d'avance

Flac

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 10 Then
ActiveSheet.Unprotect
Application.EnableEvents = False
On Error GoTo erreur
x = Application.Substitute(Target, "-", "")
If Len(x) = 0 Then
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
Exit Sub
End If
If Len(x) <> 16 Then GoTo erreur
Target = Left(x, 4) & "-" & Mid(x, 5, 4) & "-" & Mid(x, 9, 4) & "-"
& Right(x, 4)
x = x * 1
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
Exit Sub
erreur:
MsgBox Target & Chr(10) & "n'est pas un numéro valide." & Chr(10) &
Chr(10) & "Recommencez.", vbCritical, " NON VALIDE"
Target.Select
Target.ClearContents
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 10 Then
ActiveSheet.Unprotect
Target.NumberFormat = "@"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
End If
End Sub








Jacky
Le #16753121
Re..
Remplacer cette ligne et ajouter les 2 lignes avant le reste du code.
If Len(x) <> 16 Then GoTo erreur






Comme ceci:

If Len(x) <> 16 Or (Left(x, 1) <> 4 And Left(x, 1) <> 5) Then GoTo erreur
Target.Offset(0, 2 * (Left(x, 1) <> 4) + (Left(x, 1) <> 5)) = ""
Target.Offset(0, 2 * (Left(x, 1) = 4) + (Left(x, 1) = 5)) = "b"

Ps: j'ai pas testé le reste du code "Unprotect" etc....

--
Salutations
JJ


"Flac"
Bonjour,
Effectivement, il y a confusion. Je voulais parler de la colonne J.

Une erreur bête.

Merci


Flac


"Jacky" uKEuj%
Bonjour,

N'y a t-il pas confusion entre Colonne "F" et Target.Column = 10
--
Salutations
JJ


"Flac"
Bonjour,
Excel 2000
Je voudrais ajouter des contraintes additionnelles à la procédure qui
suit.
Le format des cellules de la colonne "F" (la colonne cible) est "Texte".
Je voudrais donc qu'après avoir vérifié que les 16 caractères numériques
inscrits dans la cellule de la colonne "F"
soient valides, la macro vérifie aussi 3 contraintes supplémentaires,
soit:

if "le premier caractère de la cellule cible est égal à 4" then
target.offset(0,-2) = "b"
elseif "le premier caractère de la cellule cible est égal à 5" then
target.offset(0,-1) = "b"
elseif "le premier caractère de la cellule est différent de 4 ou 5" then
goto erreur
end if

Espérant que ma requête est bien comprise, je vous remercie d'avance

Flac

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 10 Then
ActiveSheet.Unprotect
Application.EnableEvents = False
On Error GoTo erreur
x = Application.Substitute(Target, "-", "")
If Len(x) = 0 Then
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
Exit Sub
End If
If Len(x) <> 16 Then GoTo erreur
Target = Left(x, 4) & "-" & Mid(x, 5, 4) & "-" & Mid(x, 9, 4) & "-"
& Right(x, 4)
x = x * 1
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
Exit Sub
erreur:
MsgBox Target & Chr(10) & "n'est pas un numéro valide." & Chr(10) &
Chr(10) & "Recommencez.", vbCritical, " NON VALIDE"
Target.Select
Target.ClearContents
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 10 Then
ActiveSheet.Unprotect
Target.NumberFormat = "@"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
End If
End Sub












Flac
Le #16753531
Bonjour,
Merci pour la réponse.
J'ai essayé le code et ça ne fonctionne pas.
Aussitôt que j'inscris 16 caractères numériques, je n'ai pas de message
d'erreur,
même si le premier caractère est un 4 ou un 5. C'est la même chose que si
je ne change
pas le code.
Je continue d'autres alternatives.

Merci encore

Flac


"Jacky"
Re..
Remplacer cette ligne et ajouter les 2 lignes avant le reste du code.
If Len(x) <> 16 Then GoTo erreur






Comme ceci:

If Len(x) <> 16 Or (Left(x, 1) <> 4 And Left(x, 1) <> 5) Then GoTo erreur
Target.Offset(0, 2 * (Left(x, 1) <> 4) + (Left(x, 1) <> 5)) = ""
Target.Offset(0, 2 * (Left(x, 1) = 4) + (Left(x, 1) = 5)) = "b"

Ps: j'ai pas testé le reste du code "Unprotect" etc....

--
Salutations
JJ


"Flac"
Bonjour,
Effectivement, il y a confusion. Je voulais parler de la colonne J.

Une erreur bête.

Merci


Flac


"Jacky" uKEuj%
Bonjour,

N'y a t-il pas confusion entre Colonne "F" et Target.Column = 10
--
Salutations
JJ


"Flac"
Bonjour,
Excel 2000
Je voudrais ajouter des contraintes additionnelles à la procédure qui
suit.
Le format des cellules de la colonne "F" (la colonne cible) est
"Texte".
Je voudrais donc qu'après avoir vérifié que les 16 caractères
numériques inscrits dans la cellule de la colonne "F"
soient valides, la macro vérifie aussi 3 contraintes supplémentaires,
soit:

if "le premier caractère de la cellule cible est égal à 4" then
target.offset(0,-2) = "b"
elseif "le premier caractère de la cellule cible est égal à 5" then
target.offset(0,-1) = "b"
elseif "le premier caractère de la cellule est différent de 4 ou 5"
then goto erreur
end if

Espérant que ma requête est bien comprise, je vous remercie d'avance

Flac

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 10 Then
ActiveSheet.Unprotect
Application.EnableEvents = False
On Error GoTo erreur
x = Application.Substitute(Target, "-", "")
If Len(x) = 0 Then
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
Exit Sub
End If
If Len(x) <> 16 Then GoTo erreur
Target = Left(x, 4) & "-" & Mid(x, 5, 4) & "-" & Mid(x, 9, 4) &
"-" & Right(x, 4)
x = x * 1
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
Exit Sub
erreur:
MsgBox Target & Chr(10) & "n'est pas un numéro valide." & Chr(10)
& Chr(10) & "Recommencez.", vbCritical, " NON VALIDE"
Target.Select
Target.ClearContents
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 10 Then
ActiveSheet.Unprotect
Target.NumberFormat = "@"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
End If
End Sub
















Flac
Le #16754001
Bonjour,
Après maintes tentatives, j'ai trouvé.

Voici le code que je cherchais:
If Len(x) <> 16 Then GoTo erreur
If Left(x, 1) = 4 Then
Target.Offset(0, -2).Value = "b"
ElseIf Left(x, 1) = 5 Then
Target.Offset(0, -1).Value = "b"
ElseIf Left(x, 1) <> 4 Or Left(x, 1) <> 5 Then
GoTo erreur
End If

Merci, sans ton aide je n'y serais pas arrivé.

Flac




"Flac" %
Bonjour,
Merci pour la réponse.
J'ai essayé le code et ça ne fonctionne pas.
Aussitôt que j'inscris 16 caractères numériques, je n'ai pas de message
d'erreur,
même si le premier caractère est un 4 ou un 5. C'est la même chose que si
je ne change
pas le code.
Je continue d'autres alternatives.

Merci encore

Flac


"Jacky"
Re..
Remplacer cette ligne et ajouter les 2 lignes avant le reste du code.
If Len(x) <> 16 Then GoTo erreur






Comme ceci:

If Len(x) <> 16 Or (Left(x, 1) <> 4 And Left(x, 1) <> 5) Then GoTo erreur
Target.Offset(0, 2 * (Left(x, 1) <> 4) + (Left(x, 1) <> 5)) = ""
Target.Offset(0, 2 * (Left(x, 1) = 4) + (Left(x, 1) = 5)) = "b"

Ps: j'ai pas testé le reste du code "Unprotect" etc....

--
Salutations
JJ


"Flac"
Bonjour,
Effectivement, il y a confusion. Je voulais parler de la colonne J.

Une erreur bête.

Merci


Flac


"Jacky" uKEuj%
Bonjour,

N'y a t-il pas confusion entre Colonne "F" et Target.Column = 10
--
Salutations
JJ


"Flac"
Bonjour,
Excel 2000
Je voudrais ajouter des contraintes additionnelles à la procédure qui
suit.
Le format des cellules de la colonne "F" (la colonne cible) est
"Texte".
Je voudrais donc qu'après avoir vérifié que les 16 caractères
numériques inscrits dans la cellule de la colonne "F"
soient valides, la macro vérifie aussi 3 contraintes supplémentaires,
soit:

if "le premier caractère de la cellule cible est égal à 4" then
target.offset(0,-2) = "b"
elseif "le premier caractère de la cellule cible est égal à 5" then
target.offset(0,-1) = "b"
elseif "le premier caractère de la cellule est différent de 4 ou 5"
then goto erreur
end if

Espérant que ma requête est bien comprise, je vous remercie d'avance

Flac

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 10 Then
ActiveSheet.Unprotect
Application.EnableEvents = False
On Error GoTo erreur
x = Application.Substitute(Target, "-", "")
If Len(x) = 0 Then
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
Exit Sub
End If
If Len(x) <> 16 Then GoTo erreur
Target = Left(x, 4) & "-" & Mid(x, 5, 4) & "-" & Mid(x, 9, 4) &
"-" & Right(x, 4)
x = x * 1
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
Exit Sub
erreur:
MsgBox Target & Chr(10) & "n'est pas un numéro valide." & Chr(10)
& Chr(10) & "Recommencez.", vbCritical, " NON VALIDE"
Target.Select
Target.ClearContents
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 10 Then
ActiveSheet.Unprotect
Target.NumberFormat = "@"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
End If
End Sub




















Jacky
Le #16754211
Re...
C'est exactement ce que faisait le code proposé
Celui-ci efface AUSSI les "b" s'il y a Modification d'une
cellule(préalablement saisie) et si les conditions ne sont pas remplies
http://cjoint.com/?jipuCTnbiH
--
Salutations
JJ


"Flac"
Bonjour,
Après maintes tentatives, j'ai trouvé.

Voici le code que je cherchais:
If Len(x) <> 16 Then GoTo erreur
If Left(x, 1) = 4 Then
Target.Offset(0, -2).Value = "b"
ElseIf Left(x, 1) = 5 Then
Target.Offset(0, -1).Value = "b"
ElseIf Left(x, 1) <> 4 Or Left(x, 1) <> 5 Then
GoTo erreur
End If

Merci, sans ton aide je n'y serais pas arrivé.

Flac




"Flac" %
Bonjour,
Merci pour la réponse.
J'ai essayé le code et ça ne fonctionne pas.
Aussitôt que j'inscris 16 caractères numériques, je n'ai pas de message
d'erreur,
même si le premier caractère est un 4 ou un 5. C'est la même chose que
si je ne change
pas le code.
Je continue d'autres alternatives.

Merci encore

Flac


"Jacky"
Re..
Remplacer cette ligne et ajouter les 2 lignes avant le reste du code.
If Len(x) <> 16 Then GoTo erreur






Comme ceci:

If Len(x) <> 16 Or (Left(x, 1) <> 4 And Left(x, 1) <> 5) Then GoTo
erreur
Target.Offset(0, 2 * (Left(x, 1) <> 4) + (Left(x, 1) <> 5)) = ""
Target.Offset(0, 2 * (Left(x, 1) = 4) + (Left(x, 1) = 5)) = "b"

Ps: j'ai pas testé le reste du code "Unprotect" etc....

--
Salutations
JJ


"Flac"
Bonjour,
Effectivement, il y a confusion. Je voulais parler de la colonne J.

Une erreur bête.

Merci


Flac


"Jacky" uKEuj%
Bonjour,

N'y a t-il pas confusion entre Colonne "F" et Target.Column = 10
--
Salutations
JJ


"Flac"
Bonjour,
Excel 2000
Je voudrais ajouter des contraintes additionnelles à la procédure qui
suit.
Le format des cellules de la colonne "F" (la colonne cible) est
"Texte".
Je voudrais donc qu'après avoir vérifié que les 16 caractères
numériques inscrits dans la cellule de la colonne "F"
soient valides, la macro vérifie aussi 3 contraintes supplémentaires,
soit:

if "le premier caractère de la cellule cible est égal à 4" then
target.offset(0,-2) = "b"
elseif "le premier caractère de la cellule cible est égal à 5" then
target.offset(0,-1) = "b"
elseif "le premier caractère de la cellule est différent de 4 ou 5"
then goto erreur
end if

Espérant que ma requête est bien comprise, je vous remercie d'avance

Flac

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 10 Then
ActiveSheet.Unprotect
Application.EnableEvents = False
On Error GoTo erreur
x = Application.Substitute(Target, "-", "")
If Len(x) = 0 Then
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
Exit Sub
End If
If Len(x) <> 16 Then GoTo erreur
Target = Left(x, 4) & "-" & Mid(x, 5, 4) & "-" & Mid(x, 9, 4) &
"-" & Right(x, 4)
x = x * 1
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
Exit Sub
erreur:
MsgBox Target & Chr(10) & "n'est pas un numéro valide." &
Chr(10) & Chr(10) & "Recommencez.", vbCritical, " NON VALIDE"
Target.Select
Target.ClearContents
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 10 Then
ActiveSheet.Unprotect
Target.NumberFormat = "@"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
End If
End Sub
























Flac
Le #16754481
Rebonjour,
Merci, effectivement, ton code est beaucoup performant que le mien. La
syntaxe du code qui accompagne le fichier que tu as joint répare les erreurs
de mon code qui faisait en sorte que la macro ne fonctionnait pas
correctement.

Salutations

Flac


"Jacky"
Re...
C'est exactement ce que faisait le code proposé
Celui-ci efface AUSSI les "b" s'il y a Modification d'une
cellule(préalablement saisie) et si les conditions ne sont pas remplies
http://cjoint.com/?jipuCTnbiH
--
Salutations
JJ


"Flac"
Bonjour,
Après maintes tentatives, j'ai trouvé.

Voici le code que je cherchais:
If Len(x) <> 16 Then GoTo erreur
If Left(x, 1) = 4 Then
Target.Offset(0, -2).Value = "b"
ElseIf Left(x, 1) = 5 Then
Target.Offset(0, -1).Value = "b"
ElseIf Left(x, 1) <> 4 Or Left(x, 1) <> 5 Then
GoTo erreur
End If

Merci, sans ton aide je n'y serais pas arrivé.

Flac




"Flac" %
Bonjour,
Merci pour la réponse.
J'ai essayé le code et ça ne fonctionne pas.
Aussitôt que j'inscris 16 caractères numériques, je n'ai pas de message
d'erreur,
même si le premier caractère est un 4 ou un 5. C'est la même chose que
si je ne change
pas le code.
Je continue d'autres alternatives.

Merci encore

Flac


"Jacky"
Re..
Remplacer cette ligne et ajouter les 2 lignes avant le reste du code.
If Len(x) <> 16 Then GoTo erreur






Comme ceci:

If Len(x) <> 16 Or (Left(x, 1) <> 4 And Left(x, 1) <> 5) Then GoTo
erreur
Target.Offset(0, 2 * (Left(x, 1) <> 4) + (Left(x, 1) <> 5)) = ""
Target.Offset(0, 2 * (Left(x, 1) = 4) + (Left(x, 1) = 5)) = "b"

Ps: j'ai pas testé le reste du code "Unprotect" etc....

--
Salutations
JJ


"Flac"
Bonjour,
Effectivement, il y a confusion. Je voulais parler de la colonne J.

Une erreur bête.

Merci


Flac


"Jacky" uKEuj%
Bonjour,

N'y a t-il pas confusion entre Colonne "F" et Target.Column = 10
--
Salutations
JJ


"Flac"
Bonjour,
Excel 2000
Je voudrais ajouter des contraintes additionnelles à la procédure
qui suit.
Le format des cellules de la colonne "F" (la colonne cible) est
"Texte".
Je voudrais donc qu'après avoir vérifié que les 16 caractères
numériques inscrits dans la cellule de la colonne "F"
soient valides, la macro vérifie aussi 3 contraintes
supplémentaires, soit:

if "le premier caractère de la cellule cible est égal à 4" then
target.offset(0,-2) = "b"
elseif "le premier caractère de la cellule cible est égal à 5" then
target.offset(0,-1) = "b"
elseif "le premier caractère de la cellule est différent de 4 ou 5"
then goto erreur
end if

Espérant que ma requête est bien comprise, je vous remercie d'avance

Flac

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 10 Then
ActiveSheet.Unprotect
Application.EnableEvents = False
On Error GoTo erreur
x = Application.Substitute(Target, "-", "")
If Len(x) = 0 Then
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
Exit Sub
End If
If Len(x) <> 16 Then GoTo erreur
Target = Left(x, 4) & "-" & Mid(x, 5, 4) & "-" & Mid(x, 9, 4) &
"-" & Right(x, 4)
x = x * 1
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
Exit Sub
erreur:
MsgBox Target & Chr(10) & "n'est pas un numéro valide." &
Chr(10) & Chr(10) & "Recommencez.", vbCritical, " NON VALIDE"
Target.Select
Target.ClearContents
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 10 Then
ActiveSheet.Unprotect
Target.NumberFormat = "@"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
End If
End Sub




























Jacky
Le #16754601
Re...
Le code contient l'instruction:
Application.EnableEvents = False
S'il y a plantage de la macro pendant les essais, il faut "Enregistrer" et
"Fermer" Excel pour réinitialisation l'instruction "EnableEvents", sinon
plus aucun instruction ne fonctionne.
C'est certainement ce qui t'est arrivé lors du test.

--
Salutations
JJ


"Flac" u%
Rebonjour,
Merci, effectivement, ton code est beaucoup performant que le mien. La
syntaxe du code qui accompagne le fichier que tu as joint répare les
erreurs de mon code qui faisait en sorte que la macro ne fonctionnait pas
correctement.

Salutations

Flac


"Jacky"
Re...
C'est exactement ce que faisait le code proposé
Celui-ci efface AUSSI les "b" s'il y a Modification d'une
cellule(préalablement saisie) et si les conditions ne sont pas remplies
http://cjoint.com/?jipuCTnbiH
--
Salutations
JJ


"Flac"
Bonjour,
Après maintes tentatives, j'ai trouvé.

Voici le code que je cherchais:
If Len(x) <> 16 Then GoTo erreur
If Left(x, 1) = 4 Then
Target.Offset(0, -2).Value = "b"
ElseIf Left(x, 1) = 5 Then
Target.Offset(0, -1).Value = "b"
ElseIf Left(x, 1) <> 4 Or Left(x, 1) <> 5 Then
GoTo erreur
End If

Merci, sans ton aide je n'y serais pas arrivé.

Flac




"Flac" %
Bonjour,
Merci pour la réponse.
J'ai essayé le code et ça ne fonctionne pas.
Aussitôt que j'inscris 16 caractères numériques, je n'ai pas de message
d'erreur,
même si le premier caractère est un 4 ou un 5. C'est la même chose que
si je ne change
pas le code.
Je continue d'autres alternatives.

Merci encore

Flac


"Jacky"
Re..
Remplacer cette ligne et ajouter les 2 lignes avant le reste du code.
If Len(x) <> 16 Then GoTo erreur






Comme ceci:

If Len(x) <> 16 Or (Left(x, 1) <> 4 And Left(x, 1) <> 5) Then GoTo
erreur
Target.Offset(0, 2 * (Left(x, 1) <> 4) + (Left(x, 1) <> 5)) = ""
Target.Offset(0, 2 * (Left(x, 1) = 4) + (Left(x, 1) = 5)) = "b"

Ps: j'ai pas testé le reste du code "Unprotect" etc....

--
Salutations
JJ


"Flac"
Bonjour,
Effectivement, il y a confusion. Je voulais parler de la colonne J.

Une erreur bête.

Merci


Flac


"Jacky" uKEuj%
Bonjour,

N'y a t-il pas confusion entre Colonne "F" et Target.Column = 10
--
Salutations
JJ


"Flac"
Bonjour,
Excel 2000
Je voudrais ajouter des contraintes additionnelles à la procédure
qui suit.
Le format des cellules de la colonne "F" (la colonne cible) est
"Texte".
Je voudrais donc qu'après avoir vérifié que les 16 caractères
numériques inscrits dans la cellule de la colonne "F"
soient valides, la macro vérifie aussi 3 contraintes
supplémentaires, soit:

if "le premier caractère de la cellule cible est égal à 4" then
target.offset(0,-2) = "b"
elseif "le premier caractère de la cellule cible est égal à 5" then
target.offset(0,-1) = "b"
elseif "le premier caractère de la cellule est différent de 4 ou 5"
then goto erreur
end if

Espérant que ma requête est bien comprise, je vous remercie
d'avance

Flac

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 10 Then
ActiveSheet.Unprotect
Application.EnableEvents = False
On Error GoTo erreur
x = Application.Substitute(Target, "-", "")
If Len(x) = 0 Then
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
Exit Sub
End If
If Len(x) <> 16 Then GoTo erreur
Target = Left(x, 4) & "-" & Mid(x, 5, 4) & "-" & Mid(x, 9, 4)
& "-" & Right(x, 4)
x = x * 1
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
Exit Sub
erreur:
MsgBox Target & Chr(10) & "n'est pas un numéro valide." &
Chr(10) & Chr(10) & "Recommencez.", vbCritical, " NON VALIDE"
Target.Select
Target.ClearContents
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 10 Then
ActiveSheet.Unprotect
Target.NumberFormat = "@"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
End If
End Sub
































Publicité
Poster une réponse
Anonyme