Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Contraintes additionnelles

Contraintes additionnelles

8 réponses
Avatar
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
Signaler un problème avec ce contenu

8 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Jacky
Bonjour,

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


"Flac" a écrit dans le message de news:

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




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

Une erreur bête.

Merci


Flac


"Jacky" a écrit dans le message de news:
uKEuj%
Bonjour,

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


"Flac" a écrit dans le message de news:

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








Avatar
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" a écrit dans le message de news:

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

Une erreur bête.

Merci


Flac


"Jacky" a écrit dans le message de news:
uKEuj%
Bonjour,

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


"Flac" a écrit dans le message de news:

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












Avatar
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" a écrit dans le message de news:

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" a écrit dans le message de news:

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

Une erreur bête.

Merci


Flac


"Jacky" a écrit dans le message de news:
uKEuj%
Bonjour,

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


"Flac" a écrit dans le message de news:

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
















Avatar
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" a écrit dans le message de news:
%
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" a écrit dans le message de news:

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" a écrit dans le message de news:

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

Une erreur bête.

Merci


Flac


"Jacky" a écrit dans le message de news:
uKEuj%
Bonjour,

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


"Flac" a écrit dans le message de news:

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




















Avatar
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" a écrit dans le message de news:

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" a écrit dans le message de news:
%
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" a écrit dans le message de news:

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" a écrit dans le message de news:

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

Une erreur bête.

Merci


Flac


"Jacky" a écrit dans le message de news:
uKEuj%
Bonjour,

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


"Flac" a écrit dans le message de news:

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
























Avatar
Flac
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" a écrit dans le message de news:

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" a écrit dans le message de news:

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" a écrit dans le message de news:
%
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" a écrit dans le message de news:

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" a écrit dans le message de news:

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

Une erreur bête.

Merci


Flac


"Jacky" a écrit dans le message de news:
uKEuj%
Bonjour,

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


"Flac" a écrit dans le message de news:

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




























Avatar
Jacky
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" a écrit dans le message de news:
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" a écrit dans le message de news:

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" a écrit dans le message de news:

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" a écrit dans le message de news:
%
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" a écrit dans le message de news:

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" a écrit dans le message de news:

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

Une erreur bête.

Merci


Flac


"Jacky" a écrit dans le message de news:
uKEuj%
Bonjour,

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


"Flac" a écrit dans le message de news:

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