Sujet Précédent Sujet Suivant

EXCEL - validation de données

Résolu/Fermé
Croquette - 4 janv. 2010 à 15:22
 Croquette - 7 janv. 2010 à 15:24
Bonjour à tous,

je voudrais faire en sorte que dans ma cellule A4, l'utilisateur du fichier ne puisse entrer qu'un texte avec les formats suivant (les "X" correspondant à des chiffres ou des lettres quelconques):

X.X.X.X.
ou
X.X.X
ou
XX.X.
ou
XX.XX.X.
ou
X.X.
ou
XX.X.X.X.
ou
X.XX.
ou
XX.X.XX.
ou
X.X.XX.


Quelqu'un aurait il une solution? une macro? une astuce intelligente?

merci bcp
A voir également:

8 réponses

Réponse 1 / 8
Croquette
5 janv. 2010 à 11:09
Ni idea?

merciiiii si vous pouvez m'aider là dessus c'est important pour moi!
0
gilou
5 janv. 2010 à 14:09
BONJOUR
c'est marrant j'ai plutot compris que tu voulais qque chose comme cela :
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Range("a4").Value = "X.X.X.X." Then Exit Sub

If Range("a4").Value = "X.X.X.X." Then Exit Sub
If Range("a4").Value = "XX.X." Then Exit Sub
If Range("a4").Value = "XX.XX.X." Then Exit Sub
If Range("a4").Value = "X.X." Then Exit Sub
If Range("a4").Value = "XX.X.X.X." Then Exit Sub
If Range("a4").Value = "X.XX." Then Exit Sub
If Range("a4").Value = "XX.X.XX." Then Exit Sub
If Range("a4").Value = "X.X.XX." Then Exit Sub
Range("a4").Value =""
End Sub
ainsi a4 ne tolere que tes codes en x
0
Croquette > gilou
5 janv. 2010 à 14:28
Merci Gilou mais ce n'est pas exactement ça...

merci qd même!
0
Réponse 2 / 8
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 751
5 janv. 2010 à 11:55
Salut,
Je planche sur ton problème...
Dur dur!
Ma question va te paraitre stupide, mais pourquoi est ce important (au vu des différents formats que tu souhaites laisser à l'utilisateur)?
citation :
les "X" correspondant à des chiffres ou des lettres quelconques la "casse" étant importante, peux t'il y avoir des majuscules et minuscules mélangées? des chiffres et des lettres?

0
Réponse 3 / 8
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 751
5 janv. 2010 à 13:11
Je t'ai "bricolé" ce code. Il s'agit plus d'une usine à gaz pas tout à fait efficace plutôt qu'un vrai code... En fait, il repère l'emplacement des points et compare grâce à ces emplacements. En gros, si tu mets 7 points dans ta cellule (ou 4 ou 9) ce code ne décèlera aucun souci. De même si tu y inscris : A...A0.
Je te le donne quand même car c'est tout ce que j'ai trouvé pour t'aider. On ne sait jamais.
Alors pour l'utiliser ouvre ton classeur, tape ALT +F11.
Dans la petite fenêtre en haut à gauche double clique sur Feuil1 (nomdetafeuille1).
En haut de la grande fenêtre visual Basic centrale, tu as deux menus déroulants. Dans celui de gauche choisit "WorkSheet" dans celui de droite choisit "change". Tu obtient ces deux lignes : 

Private Sub Worksheet_Change(ByVal Target As Range)

End Sub


Entre ces deux lignes copie et colle le code suivant : 

If Target.Address = "$A$4" And Target.Count = 1 Then
   If IsEmpty(Target) Then
        Exit Sub
    Else
        If Len(Range("A4")) = 4 Then
            If Mid(Range("A4"), 2, 1) = "." And Mid(Range("A4"), 4, 1) = "." Then
            Exit Sub
            Else
            MsgBox ("Cette cellule doit être au format : " & Chr(10) & "#.#." & Chr(10) & "#.#.#" & Chr(10) & "##.#." & Chr(10) & "#.##." & Chr(10) & "#.#.##." & Chr(10) & "#.#.#.#." & Chr(10) & "##.##.#." & Chr(10) & "##.#.##." & Chr(10) & "##.#.#.#.")
            Range("A4").ClearContents
            Range("A4").Select
            End If
        End If
        If Len(Range("A4")) = 5 Then
            If Mid(Range("A4"), 2, 1) = "." And Mid(Range("A4"), 4, 1) = "." Then
            Exit Sub
            ElseIf Mid(Range("A4"), 3, 1) = "." And Mid(Range("A4"), 5, 1) = "." Then
            Exit Sub
            ElseIf Mid(Range("A4"), 2, 1) = "." And Mid(Range("A4"), 5, 1) = "." Then
            Exit Sub
            Else
            MsgBox ("Cette cellule doit être au format : " & Chr(10) & "#.#." & Chr(10) & "#.#.#" & Chr(10) & "##.#." & Chr(10) & "#.##." & Chr(10) & "#.#.##." & Chr(10) & "#.#.#.#." & Chr(10) & "##.##.#." & Chr(10) & "##.#.##." & Chr(10) & "##.#.#.#.")
            Range("A4").ClearContents
            Range("A4").Select
            End If
        End If
        If Len(Range("A4")) = 7 Then
            If Mid(Range("A4"), 2, 1) = "." And Mid(Range("A4"), 4, 1) = "." And Mid(Range("A4"), 7, 1) = "." Then
            Exit Sub
            Else
            MsgBox ("Cette cellule doit être au format : " & Chr(10) & "#.#." & Chr(10) & "#.#.#" & Chr(10) & "##.#." & Chr(10) & "#.##." & Chr(10) & "#.#.##." & Chr(10) & "#.#.#.#." & Chr(10) & "##.##.#." & Chr(10) & "##.#.##." & Chr(10) & "##.#.#.#.")
            Range("A4").ClearContents
            Range("A4").Select
            End If
        End If
        If Len(Range("A4")) = 8 Then
            If Mid(Range("A4"), 2, 1) = "." And Mid(Range("A4"), 4, 1) = "." And Mid(Range("A4"), 6, 1) = "." And Mid(Range("A4"), 8, 1) = "." Then
            Exit Sub
            ElseIf Mid(Range("A4"), 3, 1) = "." And Mid(Range("A4"), 6, 1) = "." And Mid(Range("A4"), 8, 1) = "." Then
            Exit Sub
            ElseIf Mid(Range("A4"), 3, 1) = "." And Mid(Range("A4"), 5, 1) = "." And Mid(Range("A4"), 8, 1) = "." Then
            Exit Sub
            Else
            MsgBox ("Cette cellule doit être au format : " & Chr(10) & "#.#." & Chr(10) & "#.#.#" & Chr(10) & "##.#." & Chr(10) & "#.##." & Chr(10) & "#.#.##." & Chr(10) & "#.#.#.#." & Chr(10) & "##.##.#." & Chr(10) & "##.#.##." & Chr(10) & "##.#.#.#.")
            Range("A4").ClearContents
            Range("A4").Select
            End If
        End If
        If Len(Range("A4")) = 9 Then
            If Mid(Range("A4"), 3, 1) = "." And Mid(Range("A4"), 5, 1) = "." And Mid(Range("A4"), 7, 1) = "." And Mid(Range("A4"), 9, 1) = "." Then
            Exit Sub
            Else
            MsgBox ("Cette cellule doit être au format : " & Chr(10) & "#.#." & Chr(10) & "#.#.#" & Chr(10) & "##.#." & Chr(10) & "#.##." & Chr(10) & "#.#.##." & Chr(10) & "#.#.#.#." & Chr(10) & "##.##.#." & Chr(10) & "##.#.##." & Chr(10) & "##.#.#.#.")
            Range("A4").ClearContents
            Range("A4").Select
            End If
        End If
        If Len(Range("A4")) <> 9 And Len(Range("A4")) <> 8 And Len(Range("A4")) <> 7 And Len(Range("A4")) <> 5 And Len(Range("A4")) <> 4 Then
        MsgBox ("Cette cellule doit être au format : " & Chr(10) & "#.#." & Chr(10) & "#.#.#" & Chr(10) & "##.#." & Chr(10) & "#.##." & Chr(10) & "#.#.##." & Chr(10) & "#.#.#.#." & Chr(10) & "##.##.#." & Chr(10) & "##.#.##." & Chr(10) & "##.#.#.#.")
        Range("A4").ClearContents
        Range("A4").Select
        End If
    End If
End If


Ferme la fenêtre Visual Basic et teste...
0
Croquette
5 janv. 2010 à 14:30
Salut Pikaju,

Un grand merci pour ta réponse!

Je pense que ta méthode de compter les points pourrait me convenir. Le souci c'est qu'il n'y a aucune action lorsque je change qqchose sur ma feuille. Pourtant je pense avoir correctement intégré le code dans VBA...

Bonne année!
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 751 > Croquette
5 janv. 2010 à 14:31
Mon code ne fonctionne que lorsque A4 est compétée.
0
Croquette > pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024
5 janv. 2010 à 14:34
Oui j'ai bien essayé tu penses ^^

et bien cela ne marche pas chez moi...

Est ce que ce la pourrait venir du fait que ma cellule A4 est une cellule fusionnée?
0
Réponse 4 / 8
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 751
5 janv. 2010 à 14:37
Non. La fusion n'affecte pas dans ce cas l'adresse de la cellule. Peux tu joindre ici même une copie de ton classeur sans données confidentielles en utilisant un service de pièces jointes comme cjoint : https://www.cjoint.com/
ou cijoint : http://www.cijoint.fr/
0
Croquette
5 janv. 2010 à 15:00
http://www.cijoint.fr/cjlink.php?file=cj201001/cij62vpJ95.xls

J e ne peux pas vraiment anomymiser mon fichier cela prendrait des jours... ^^

Cela dit j'i essayé sur un classeur vierge et c'est le meme souci : pas d'action...
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 751 > Croquette
5 janv. 2010 à 15:05
Ton fichier fonctionne bien chez moi. Essaye la procédure que je t'ai mis ci dessous... dans un post précédent.
EDIT : Post 10
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 8
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 751
5 janv. 2010 à 14:45
Essaye ceci :
J'ai ajouté : Application.EnableEvents = True qui autorise le déclenchement d'un évenement et changé les Range("A4").ClearContents qui ne fonctionnent pas avec les cellules fusionnées... 

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = True
If Target.Address = "$A$4" And Target.Count = 1 Then
   If IsEmpty(Target) Then
        Exit Sub
    Else
        If Len(Range("A4")) = 4 Then
            If Mid(Range("A4"), 2, 1) = "." And Mid(Range("A4"), 4, 1) = "." Then
            Exit Sub
            Else
            MsgBox ("Cette cellule doit être au format : " & Chr(10) & "#.#." & Chr(10) & "#.#.#" & Chr(10) & "##.#." & Chr(10) & "#.##." & Chr(10) & "#.#.##." & Chr(10) & "#.#.#.#." & Chr(10) & "##.##.#." & Chr(10) & "##.#.##." & Chr(10) & "##.#.#.#.")
            Range("A4") = ""
            Range("A4").Select
            End If
        End If
        If Len(Range("A4")) = 5 Then
            If Mid(Range("A4"), 2, 1) = "." And Mid(Range("A4"), 4, 1) = "." Then
            Exit Sub
            ElseIf Mid(Range("A4"), 3, 1) = "." And Mid(Range("A4"), 5, 1) = "." Then
            Exit Sub
            ElseIf Mid(Range("A4"), 2, 1) = "." And Mid(Range("A4"), 5, 1) = "." Then
            Exit Sub
            Else
            MsgBox ("Cette cellule doit être au format : " & Chr(10) & "#.#." & Chr(10) & "#.#.#" & Chr(10) & "##.#." & Chr(10) & "#.##." & Chr(10) & "#.#.##." & Chr(10) & "#.#.#.#." & Chr(10) & "##.##.#." & Chr(10) & "##.#.##." & Chr(10) & "##.#.#.#.")
            Range("A4") = ""
            Range("A4").Select
            End If
        End If
        If Len(Range("A4")) = 7 Then
            If Mid(Range("A4"), 2, 1) = "." And Mid(Range("A4"), 4, 1) = "." And Mid(Range("A4"), 7, 1) = "." Then
            Exit Sub
            Else
            MsgBox ("Cette cellule doit être au format : " & Chr(10) & "#.#." & Chr(10) & "#.#.#" & Chr(10) & "##.#." & Chr(10) & "#.##." & Chr(10) & "#.#.##." & Chr(10) & "#.#.#.#." & Chr(10) & "##.##.#." & Chr(10) & "##.#.##." & Chr(10) & "##.#.#.#.")
            Range("A4") = ""
            Range("A4").Select
            End If
        End If
        If Len(Range("A4")) = 8 Then
            If Mid(Range("A4"), 2, 1) = "." And Mid(Range("A4"), 4, 1) = "." And Mid(Range("A4"), 6, 1) = "." And Mid(Range("A4"), 8, 1) = "." Then
            Exit Sub
            ElseIf Mid(Range("A4"), 3, 1) = "." And Mid(Range("A4"), 6, 1) = "." And Mid(Range("A4"), 8, 1) = "." Then
            Exit Sub
            ElseIf Mid(Range("A4"), 3, 1) = "." And Mid(Range("A4"), 5, 1) = "." And Mid(Range("A4"), 8, 1) = "." Then
            Exit Sub
            Else
            MsgBox ("Cette cellule doit être au format : " & Chr(10) & "#.#." & Chr(10) & "#.#.#" & Chr(10) & "##.#." & Chr(10) & "#.##." & Chr(10) & "#.#.##." & Chr(10) & "#.#.#.#." & Chr(10) & "##.##.#." & Chr(10) & "##.#.##." & Chr(10) & "##.#.#.#.")
            Range("A4") = ""
            Range("A4").Select
            End If
        End If
        If Len(Range("A4")) = 9 Then
            If Mid(Range("A4"), 3, 1) = "." And Mid(Range("A4"), 5, 1) = "." And Mid(Range("A4"), 7, 1) = "." And Mid(Range("A4"), 9, 1) = "." Then
            Exit Sub
            Else
            MsgBox ("Cette cellule doit être au format : " & Chr(10) & "#.#." & Chr(10) & "#.#.#" & Chr(10) & "##.#." & Chr(10) & "#.##." & Chr(10) & "#.#.##." & Chr(10) & "#.#.#.#." & Chr(10) & "##.##.#." & Chr(10) & "##.#.##." & Chr(10) & "##.#.#.#.")
            Range("A4") = ""
            Range("A4").Select
            End If
        End If
        If Len(Range("A4")) <> 9 And Len(Range("A4")) <> 8 And Len(Range("A4")) <> 7 And Len(Range("A4")) <> 5 And Len(Range("A4")) <> 4 Then
        MsgBox ("Cette cellule doit être au format : " & Chr(10) & "#.#." & Chr(10) & "#.#.#" & Chr(10) & "##.#." & Chr(10) & "#.##." & Chr(10) & "#.#.##." & Chr(10) & "#.#.#.#." & Chr(10) & "##.##.#." & Chr(10) & "##.#.##." & Chr(10) & "##.#.#.#.")
        Range("A4") = ""
        Range("A4").Select
        End If
    End If
End If
End Sub
0
Croquette
5 janv. 2010 à 15:08
Merci pikaju ça marche du tonnerre maintenant!!!

c'est très sympa de ta part!

je te souhaite une merveilleuse année!
0
Réponse 6 / 8
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 751
5 janv. 2010 à 15:09
tant mieux ça fait plaisir ;-)
Bonne année à toi aussi
0
Croquette
5 janv. 2010 à 17:34
Salut Pikaju,

en testant la bete je me suis rendue compte que j'avais fait une bourde dans mon premier post qui apparemment s'est répercutée dans ton code...

Au deuxième exemple de format il faut lire X.X.X. et non pas X.X.X

Comment je peux corriger??,

merci de ton aide
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 751 > Croquette
6 janv. 2010 à 08:50
Bonjour,
Voici le code complet avec, en gras, les lignes modifiées : 

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = True
If Target.Address = "$A$4" And Target.Count = 1 Then
   If IsEmpty(Target) Then
        Exit Sub
    Else
        If Len(Range("A4")) = 4 Then
            If Mid(Range("A4"), 2, 1) = "." And Mid(Range("A4"), 4, 1) = "." Then
            Exit Sub
            Else
            MsgBox ("Cette cellule doit être au format : " & Chr(10) & "#.#." & Chr(10) & "#.#.#." & Chr(10) & "##.#." & Chr(10) & "#.##." & Chr(10) & "#.#.##." & Chr(10) & "#.#.#.#." & Chr(10) & "##.##.#." & Chr(10) & "##.#.##." & Chr(10) & "##.#.#.#.")
            Range("A4") = ""
            Range("A4").Select
            End If
        End If
        If Len(Range("A4")) = 5 Then
           ' If Mid(Range("A4"), 2, 1) = "." And Mid(Range("A4"), 4, 1) = "." Then -->ligne à supprimer
            'Exit Sub ----> ligne à supprimer
            If Mid(Range("A4"), 3, 1) = "." And Mid(Range("A4"), 5, 1) = "." Then ' sur cette ligne le 1er mot est à changer, if au lieu de elseif
            Exit Sub
            ElseIf Mid(Range("A4"), 2, 1) = "." And Mid(Range("A4"), 5, 1) = "." Then
            Exit Sub
            Else
            MsgBox ("Cette cellule doit être au format : " & Chr(10) & "#.#." & Chr(10) & "#.#.#." & Chr(10) & "##.#." & Chr(10) & "#.##." & Chr(10) & "#.#.##." & Chr(10) & "#.#.#.#." & Chr(10) & "##.##.#." & Chr(10) & "##.#.##." & Chr(10) & "##.#.#.#.")
            Range("A4") = ""
            Range("A4").Select
            End If
        End If
       If Len(Range("A4")) = 6 Then 'ajouter tout ce paragraphe
            If Mid(Range("A4"), 2, 1) = "." And Mid(Range("A4"), 4, 1) = "." And Mid(Range("A4"), 6, 1) = "." Then
            Exit Sub
            Else
            MsgBox ("Cette cellule doit être au format : " & Chr(10) & "#.#." & Chr(10) & "#.#.#." & Chr(10) & "##.#." & Chr(10) & "#.##." & Chr(10) & "#.#.##." & Chr(10) & "#.#.#.#." & Chr(10) & "##.##.#." & Chr(10) & "##.#.##." & Chr(10) & "##.#.#.#.")
            Range("A4") = ""
            Range("A4").Select
            End If
        End If
        If Len(Range("A4")) = 7 Then
            If Mid(Range("A4"), 2, 1) = "." And Mid(Range("A4"), 4, 1) = "." And Mid(Range("A4"), 7, 1) = "." Then
            Exit Sub
            Else
            MsgBox ("Cette cellule doit être au format : " & Chr(10) & "#.#." & Chr(10) & "#.#.#." & Chr(10) & "##.#." & Chr(10) & "#.##." & Chr(10) & "#.#.##." & Chr(10) & "#.#.#.#." & Chr(10) & "##.##.#." & Chr(10) & "##.#.##." & Chr(10) & "##.#.#.#.")
            Range("A4") = ""
            Range("A4").Select
            End If
        End If
        If Len(Range("A4")) = 8 Then
            If Mid(Range("A4"), 2, 1) = "." And Mid(Range("A4"), 4, 1) = "." And Mid(Range("A4"), 6, 1) = "." And Mid(Range("A4"), 8, 1) = "." Then
            Exit Sub
            ElseIf Mid(Range("A4"), 3, 1) = "." And Mid(Range("A4"), 6, 1) = "." And Mid(Range("A4"), 8, 1) = "." Then
            Exit Sub
            ElseIf Mid(Range("A4"), 3, 1) = "." And Mid(Range("A4"), 5, 1) = "." And Mid(Range("A4"), 8, 1) = "." Then
            Exit Sub
            Else
            MsgBox ("Cette cellule doit être au format : " & Chr(10) & "#.#." & Chr(10) & "#.#.#." & Chr(10) & "##.#." & Chr(10) & "#.##." & Chr(10) & "#.#.##." & Chr(10) & "#.#.#.#." & Chr(10) & "##.##.#." & Chr(10) & "##.#.##." & Chr(10) & "##.#.#.#.")
            Range("A4") = ""
            Range("A4").Select
            End If
        End If
        If Len(Range("A4")) = 9 Then
            If Mid(Range("A4"), 3, 1) = "." And Mid(Range("A4"), 5, 1) = "." And Mid(Range("A4"), 7, 1) = "." And Mid(Range("A4"), 9, 1) = "." Then
            Exit Sub
            Else
            MsgBox ("Cette cellule doit être au format : " & Chr(10) & "#.#." & Chr(10) & "#.#.#." & Chr(10) & "##.#." & Chr(10) & "#.##." & Chr(10) & "#.#.##." & Chr(10) & "#.#.#.#." & Chr(10) & "##.##.#." & Chr(10) & "##.#.##." & Chr(10) & "##.#.#.#.")
            Range("A4") = ""
            Range("A4").Select
            End If
        End If
        If Len(Range("A4")) <> 9 And Len(Range("A4")) <> 8 And Len(Range("A4")) <> 7 And Len(Range("A4")) <> 5 And Len(Range("A4")) <> 4 Then
        MsgBox ("Cette cellule doit être au format : " & Chr(10) & "#.#." & Chr(10) & "#.#.#." & Chr(10) & "##.#." & Chr(10) & "#.##." & Chr(10) & "#.#.##." & Chr(10) & "#.#.#.#." & Chr(10) & "##.##.#." & Chr(10) & "##.#.##." & Chr(10) & "##.#.#.#.")
        Range("A4") = ""
        Range("A4").Select
        End If
    End If
End If
End Sub
0
Croquette > pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024
6 janv. 2010 à 10:13
Vraiment excellent...

un GRAAAAAND MERCI pour ton aide, c'est génial.

Bonne journée!
anne
0
Réponse 7 / 8
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 751
6 janv. 2010 à 10:17
A bientôt alors.
Bonne journée à toi
0
Croquette
6 janv. 2010 à 20:11
Bon ben je suis bete...

J'en avais oublié un: XX.X.X.

J'ai essayé de modifier le code mais sans succès (c'est une usine à gaz donc toi seul à le secret?! ^^)

désolé encore pour ça...
merci si tu peu m'aider...
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 751 > Croquette
7 janv. 2010 à 08:32
Salut Croquette!
Non tu n'es pas bête, j'aurais du t'expliquer pour que tu puisses modifier le code à ta guise. J'ai tout refait ce matin (rassures toi, ça ne m'a pris que 5 minutes), en tenant compte :
- du fait que tu préfères les "case" (j'ai cru comprendre ça sur un autre sujet)
- de mon erreur en annotant ma procédure.
Donc lit bien dans le code ce qui apparaitra en vert dans Visual Basic. Les phrases commençant par ' sont des commentaires et n'influent en rien le comportement de la procédure.
Alors ce code : 

Private Sub Worksheet_Change(ByVal Target As Range)
'autorise le déclenchement d'un évenement
Application.EnableEvents = True
'Si la cellule A4 est sélectionnée et qu'une seule cellule est sélectionnée
If Target.Address = "$A$4" And Target.Count = 1 Then
'Si A4 est vide alors on quitte la procédure
    If IsEmpty(Target) Then
        Exit Sub
'sinon
    Else
'on étudie les cas selon le nombre de caractères contenus dans A4
    Select Case Len(Range("A4"))
'cas ou A4 contient 4 caractères (ex : X.X.)
        Case 4
               'petit point de syntaxe :
            'Mid(Range("A4"), 2, 1)
            'Range("A4") correspond à la chaîne de caractères à "analyser"
            '2 est la position du caractère qui marque le début de la partie à extraire
            'et 1 correspond au nombre de caractères à renvoyer. Ce qui nous donne :
            'Si en 2ème position on trouve un point et en 4ème un point également alors
            If Mid(Range("A4"), 2, 1) = "." And Mid(Range("A4"), 4, 1) = "." Then
            'c est bon donc on sort de la procédure
            Exit Sub
            'sinon
            Else
            'affiche le message
            MsgBox ("Cette cellule doit être au format : " & Chr(10) & "#.#." & Chr(10) & "#.#.#." & Chr(10) & "##.#." & Chr(10) & "#.##." & Chr(10) & "#.#.##." & Chr(10) & "#.#.#.#." & Chr(10) & "##.##.#." & Chr(10) & "##.#.##." & Chr(10) & "##.#.#.#.")
            '"vide" A4
            Range("A4") = ""
            'sélectionne A4
            Range("A4").Select
            End If
        
        Case 5
            'ici on notera qu'il y a deux possibilités selon la place des points (XX.X. ou X.XX.)
            'd'où l'utilisation de ElseIf (sinon si)
            If Mid(Range("A4"), 3, 1) = "." And Mid(Range("A4"), 5, 1) = "." Then
            Exit Sub
            ElseIf Mid(Range("A4"), 2, 1) = "." And Mid(Range("A4"), 5, 1) = "." Then
            Exit Sub
            Else
            MsgBox ("Cette cellule doit être au format : " & Chr(10) & "#.#." & Chr(10) & "#.#.#." & Chr(10) & "##.#." & Chr(10) & "#.##." & Chr(10) & "#.#.##." & Chr(10) & "#.#.#.#." & Chr(10) & "##.##.#." & Chr(10) & "##.#.##." & Chr(10) & "##.#.#.#.")
            Range("A4") = ""
            Range("A4").Select
            End If
        
       Case 6
            If Mid(Range("A4"), 2, 1) = "." And Mid(Range("A4"), 4, 1) = "." And Mid(Range("A4"), 6, 1) = "." Then
            Exit Sub
            Else
            MsgBox ("Cette cellule doit être au format : " & Chr(10) & "#.#." & Chr(10) & "#.#.#." & Chr(10) & "##.#." & Chr(10) & "#.##." & Chr(10) & "#.#.##." & Chr(10) & "#.#.#.#." & Chr(10) & "##.##.#." & Chr(10) & "##.#.##." & Chr(10) & "##.#.#.#.")
            Range("A4") = ""
            Range("A4").Select
            End If
        
        Case 7
            If Mid(Range("A4"), 2, 1) = "." And Mid(Range("A4"), 4, 1) = "." And Mid(Range("A4"), 7, 1) = "." Then
            Exit Sub
            ElseIf Mid(Range("A4"), 3, 1) = "." And Mid(Range("A4"), 5, 1) = "." And Mid(Range("A4"), 7, 1) = "." Then
            Exit Sub
            Else
            MsgBox ("Cette cellule doit être au format : " & Chr(10) & "#.#." & Chr(10) & "#.#.#." & Chr(10) & "##.#." & Chr(10) & "#.##." & Chr(10) & "#.#.##." & Chr(10) & "#.#.#.#." & Chr(10) & "##.##.#." & Chr(10) & "##.#.##." & Chr(10) & "##.#.#.#.")
            Range("A4") = ""
            Range("A4").Select
            End If
        
        Case 8
            If Mid(Range("A4"), 2, 1) = "." And Mid(Range("A4"), 4, 1) = "." And Mid(Range("A4"), 6, 1) = "." And Mid(Range("A4"), 8, 1) = "." Then
            Exit Sub
            ElseIf Mid(Range("A4"), 3, 1) = "." And Mid(Range("A4"), 6, 1) = "." And Mid(Range("A4"), 8, 1) = "." Then
            Exit Sub
            ElseIf Mid(Range("A4"), 3, 1) = "." And Mid(Range("A4"), 5, 1) = "." And Mid(Range("A4"), 8, 1) = "." Then
            Exit Sub
            Else
            MsgBox ("Cette cellule doit être au format : " & Chr(10) & "#.#." & Chr(10) & "#.#.#." & Chr(10) & "##.#." & Chr(10) & "#.##." & Chr(10) & "#.#.##." & Chr(10) & "#.#.#.#." & Chr(10) & "##.##.#." & Chr(10) & "##.#.##." & Chr(10) & "##.#.#.#.")
            Range("A4") = ""
            Range("A4").Select
            End If
        
        Case 9
            If Mid(Range("A4"), 3, 1) = "." And Mid(Range("A4"), 5, 1) = "." And Mid(Range("A4"), 7, 1) = "." And Mid(Range("A4"), 9, 1) = "." Then
            Exit Sub
            Else
            MsgBox ("Cette cellule doit être au format : " & Chr(10) & "#.#." & Chr(10) & "#.#.#." & Chr(10) & "##.#." & Chr(10) & "#.##." & Chr(10) & "#.#.##." & Chr(10) & "#.#.#.#." & Chr(10) & "##.##.#." & Chr(10) & "##.#.##." & Chr(10) & "##.#.#.#.")
            Range("A4") = ""
            Range("A4").Select
            End If
        'pour tous les autres cas
        Case Else
        MsgBox ("Cette cellule doit être au format : " & Chr(10) & "#.#." & Chr(10) & "#.#.#." & Chr(10) & "##.#." & Chr(10) & "#.##." & Chr(10) & "#.#.##." & Chr(10) & "#.#.#.#." & Chr(10) & "##.##.#." & Chr(10) & "##.#.##." & Chr(10) & "##.#.#.#.")
        Range("A4") = ""
        Range("A4").Select
        
    End If
End If
End Sub

Si tu as un souci n'hésite pas à revenir.
0
Croquette > pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024
7 janv. 2010 à 12:31
Et bien voila, c'est nickel ! merci pijaku!

petite question (peut etre que tu auras la réponse ^^)

voila, j'ai fais ce petit code qui interdit de sélectionner certaines cellule de ma feuille. Cela marche bien (sauf que si l'utilisateur double clic sur un des cellules 'interdites' il peut qd même y accéder, mais bon j'ai pas trouvé d'autre solution - je ne veux pas de protection de feuille).

Par contre je voudrais que l'utilisateur puisse qd même sélectionner la ligne entière s'il le souhaite, mais comme la plupart du temps se trouve une cellule 'interdite' sur la ligne, ma macro s'active (et elle a raison! ^^).

Aurais tu une idée là dessus? merci

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Set Rg = Range("H40:I56,I59:I75,E94:H94,I78:I94,I113:I114,I118:I134,E137:I137,I138,I140,I160,I162,I164,I184,I186,H195:I197,I211,I215:I231,E251:H251,I235:I251")

If Not Application.Intersect(Target, Rg) Is Nothing Then _
Range("A2").Select

If Not Application.Intersect(Target, Rg) Is Nothing Then _
MsgBox "You are not allowed to modify the content of green cells"
0
Croquette > pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024
7 janv. 2010 à 12:39
Et puis aussi merci pour les explications dans le code!
0
Réponse 8 / 8
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 751
7 janv. 2010 à 13:04
1- de rien pour les explications. Tu as assimilé cette macro?
2- pour ton souci de "protection", j'ai trouvé ici : https://www.excel-downloads.com/threads/empecher-lecriture-dans-une-cellule.78034/
sur le post de Bruce68 du 03/07/2007 à 02h25 du matin!!
une méthode par validation de données.
Tu sélectionnes toutes les cellules que tu désires protéger,
Données/Validation
dans l'onglet option :
- autoriser : choisir "personnalisé"
- Formule : ""
dans l'onglet alerte d'erreur :
- style : Arrêt
- titre : "Not Allowed"
- message d'erreur : "You are not allowed to modify the content of green cells"
OK
0
Croquette
7 janv. 2010 à 15:24
1 - oui c'est parfait. Tout est clair!
2 - merci cela marche très bien...

Merci pour tout pijaku !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Croquette
0