Utilisation de la syntaxe Target.SpecialCells

VBA
1

Bonjour Tous,
J’ai trouvé ce code VBA (crédit à l’auteur dont j’ai oublié le nom) et que j’ai tenté de documenter à l’aide de mes lectures ('commentaires )

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Procédure si une cellule de la feuille est sélectionnée. Le paramètre Target correspond à la cellule sélectionnée
Dim V1 As Range
‘Déclaration de la variable V1 comme plage de cellule avec l’instruction DIM … As Range*
If Target.Count > 1 Then Exit Sub
‘Si plus d’une cellule est sélectionnée, fin de la Sub…*
Set V1 = Target.SpecialCells(xlCellTypeAllValidation)
‘Attribution d’une valeur à V1 avec instruction SET*
If Not Intersect(V1, Target) Is Nothing Then
'Procédure déclenchée si clic dans n’importe quelle cellule avec critère validation*
Target = Left(Target, 3)
End If
End Sub
J’aimerais modifier cette procédure évenementielle pour l’appliquer à 1 colonne spécifique avec critère de validation.
Je ne sais pas comment procéder.
Merci pour votre aide

2

Bonjour
À la place de cette ligne de code :

If Not Intersect(V1, Target) Is Nothing Then

Tu peux mettre par exemple pour la colonne A (colonne 1) cette ligne de code :

if Target.Column = 1

Pour la colonne B (colonne 2)

if Target.Column = 2

Donc juste à déterminer le numéro de ta colonne et adapter en fonction cette ligne

Avec cette méthode cette ligne de code devient inutile donc à supprimer :

Set V1 = Target.SpecialCells(xlCellTypeAllValidation)

Espérant avoir répondu à ton attente

3

Si tu veux en plus de la colonne la condition :

If SpecialCells(xlCellTypeAllValidation)

Mets comme ceci :
Pour la colonne 1
if Target.Column = 1
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
Else
Le code
End if
End if
4

Bonjour FFO,
j’ai modifié le code comme suit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Vl As Range
If Target.Count > 1 Then Exit Sub
Set Vl = Range(« J:J »)
If Not Intersect(Vl, Target) Is Nothing Then
Target = Left(Target, 3)
End If
End Sub

Cela fonctionne et ne gêne en rien les critères de validation dans les autres colonnes.
Le seul hic est que je dois cliquer deux fois sur la cellule de la colonne J : 1 fois pour faire le choix dans la liste déroulante, 1 autre fois pour que les 3 premières lettres correspondant à Target apparaissent…
Y’aurait-il un moyen de régler cela ?
Merci d’avance

5

Bonjour
Finalement tu as pris une autre option
L essentiel est qu elle fonctionne comme tu le souhaites
Pour ta difficulté liée à une double intervention je pense que tu as choisi la mauvaise procédure événementielle basée sur le changement de sélection
Dans ce que tu cherches à réaliser j opterais plutôt sur celle qui concerne le changement du contenu de la cellule
Pour cela modidifie le nom de la Sub toute première ligne de code mets en lieu et place cette ligne de code :

Private Sub Worksheet_Change(ByVal Target As Range)

Puis concerve le reste de ta procedure ce qui donne :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Vl As Range
If Target.Count > 1 Then Exit Sub
Set Vl = Range(« J:J »)
If Not Intersect(Vl, Target) Is Nothing Then
Target = Left(Target, 3)
End If
End Sub

Je pense que cela devrait être mieux
Dis moi

6

Bonjour FFO,
J’ai testé le code et cela ne marche pas… J’ai toute la chaîne de caractères qui s’affiche…
Est-ce peut-être parce que j’ai déjà une procédure Worksheet_Change pour les autres listes déroulantes de la feuille Excel considérée?
Cdt
Mwasikitoko

7

Bonjour
Effectivement si cette procédure existe déjà dans cette feuille il faut intégrer ton code à l’intérieur
Dans cette procédure avant le End Sub mets ces lignes de code :
If Target.Count > 1 Then Exit Sub
Set Vl = Range(« J:J »)
If Not Intersect(Vl, Target) Is Nothing Then
Application.EnableEvents = False
Target = Left(Target, 3)
Application.EnableEvents = True
End If
dans la liste des déclarations juste après
Private Sub Worksheet_Change(ByVal Target As Range)
ajoute cette ligne :
Dim Vl As Range
J’ai fais des essais avec un classeur tout neuf cela marche nickel mais avec cette seule procédure
Si cela ne fonctionne toujours pas il faut que tu me transmettes ton fichier après avois supprimé toutes les données confidentielles pour que je regarde car en fonction des lignes de code déjà existante il faut peut être intégrer celle-ci d’une manière particulière
Tu peux aussi me transmettre les lignes existantes pour je les combine

Tiens moi informé

8

Merci FFO
Je teste de suite si jamais cela ne fonctionne pas…
Est-il possible de t’envoyer le fichier en MP…
Après je remettrais le code dans le forum pour que cela serve à tout un chacun si possible?
Mwasikitoko

9

Peux tu préciser :

Est-il possible de t’envoyer le fichier en MP…

Cela correspond à quel type de fichier?

10

FFO, je ne saisis pas le sens de la question… il s’agit d’un listing de conventions signées avec l’institution dans laquelle je travaille et des partenaires… Je voudrais en faire un suivi…
Merci

11

Tu me proposes d envoyer ton fichier en MP :

« Est-il possible de t’envoyer le fichier en MP… »

D ou ma question qu est ce qu un fichier en MP quel type de fichier est ce?
Je ne connais pas ce genre de fichier donc difficile de te répondre
Merci de M en dire plus le contrat en t

12

Ah OK
MP pour message privé
J’ai testé l’insert du code dans la première procédure et cela ne marche pas :cry:
Mwasikitoko

13

Pas d autre choix que de me transmettre l idéale le fichier sans donnée confidentielle
Ou à défaut tout le code événementiel avec l ensemble des procédures des listes de validation et avec mon code proposé intégré
Tu peux transmettre ton fichier sans aucune donnée je ne pense pas que l une ou plusieurs d entres elles soient à l origine de ton échec

Merci d avance

14

Petite précision
Pour m envoyer ton fichier utilise la 7eme icône avec la flèche vers le haut dans le bandeau qui se situe en haut de ta fenêtre de réponse

Dans l attente

15

OK …Je m’y attelle de suite

16

Bonsoir FFO,
Me voici de retour…
Je transfère le fichier en laissant la feuille Liste Accords Original…la copie de cette feuille est Liste Accords FFO avec ton code intégré…
Il a l’air de fonctionner mais je reçois un message d’erreur qui ferme le fichier
La méthode ‹ _Default › de l’objet "Range’ a échoué et clic sur débogage ferme le fichier.
Bref … c’est compliqué
Registre Accord 2020 FFO.xlsm (381,4 Ko) Message Erreur

17

Bonjour
Tu n’as pas mis mon dernier code transmis dans son intégralité d’où certainement ce plantage
Les lignes :

Application.EnableEvents = False
et
Application.EnableEvents = True

dans la partie qui nous concerne sont absentes

J’ai pour notre traitement que ceci :

If Target.Count > 1 Then Exit Sub
'Attribution de la plage Col. J à la variable V1 avec instruction SET
Set Vl = Range(« J:J »)
'La procédure se déclenche quand on clique n’importe où dans la colonne J uniquement
If Not Intersect(Vl, Target) Is Nothing Then
'La valeur target comprendra les 3 premières lettres de la valeur affichée dans la cellule aprés choix liste déroulante
Target = Left(Target, 3)
End If

Les 2 lignes manquantes sont indispensables pour la raison suivante :
Cette procédure évènementielle se déclenche à chaque changement du contenu d’une cellule de la colonne J
Au départ donc déclanchement de cette procédure lorsque en colonne J par un choix effectué dans une cellule celle-ci à son contenu modifié : normal
Mais dans la partie qui nous concerne on vient ici par cette ligne de code :
Target = Left(Target, 3)
modifié à nouveau son contenu d’où redéclenchement de la procédure et ainsi de suite
La procédure tourne en boucle
D’où la nécessité de ces 2 lignes de code manquante la première pour stopper tout évènement :

Application.EnableEvents = False

le code qui modifie la cellule sans nouveau déclenchement de la procédure suite à cette instruction mis en place

Target = Left(Target, 3)

La deuxième manquante pour réactiver les évènements et ainsi de permettre cette procédure de fonctionner à la prochaine saisie dans l’onglet

Application.EnableEvents = True

Ce qui donne ces lignes de code pour cette partie :

Application.EnableEvents = False
Target = Left(Target, 3)
Application.EnableEvents = True

Et pour un ensemble de ligne pour le traitement de la colonne J :

If Target.Count > 1 Then Exit Sub
'Attribution de la plage Col. J à la variable V1 avec instruction SET
Set Vl = Range(« J:J »)
'La procédure se déclenche quand on clique n’importe où dans la colonne J uniquement
If Not Intersect(Vl, Target) Is Nothing Then
'La valeur target comprendra les 3 premières lettres de la valeur affichée dans la cellule aprés choix liste déroulante
Application.EnableEvents = False
Target = Left(Target, 3)
Application.EnableEvents = True
End If

D’ailleurs ces 2 lignes manquantes sont bien présentes dans les autres traitements mais ne concerne pas celui-ci

J’ai modifié ton fichier dans cet esprit et pour moi après essai tout fonctionne sans bug

Fais des essais de ton côté et dis moi

Registre Accord 2020 FFO.xlsm (380,5 Ko)

18

Bonjour FFO,
désolée de ne pas avoir suivi les instructions à la lettre.
Je réalise effectivement que je n’ai même pas été en mesure de faire de la recopie…
C’est vraiment grave docteur :astonished: :astonished:
Sinon, j’ai fait les tests et tout fonctionne…
Si je pouvais je te sauterais au cou pour te remercier… :rofl: :rofl:
Je te remercie également pour avoir pris la peine de m’expliquer le pourquoi du comment de chaque étape.
Au plaisir de t’avoir rencontré et c’est pas fini …
Mwasikitoko

19

Bonjour
Tu es excusable car dans mon avant dernière proposition ces lignes indispensables n’y étaient pas donc je plaide moi aussi un peu coupable
Une petite suggestion
Si un jour la procédure ne déclenchent pas pense à ces lignes de codes dont l’une aurait été exécutée et la suivante suite à un bug ne l’aurait pas été ce qui te mets dans une situation où les évènements ne seraient plus actif
Seul solution les remettre en fonction soit en réexécutant la deuxième dans une macro classique dédiée soit fermer Excel et le ré-ouvrir
Donc prévoir cet éventualité
A ta dispo si besoin mais sauté au coup c est trés déconseillé actuellement par les temps qui courent
C’est gentil quand même
Merci

20

Ah sacré Corona… :rofl:
Et encore merci pour le conseil de dernière minute…
Trop TOP
Mwasikitoko