XL 2013 peut-on raccourcir ce code ?

[Usine à gaz]

Bonjour à touts et à tous,

J'ai le code ci-dessous :

Private Sub Worksheet_SelectionChange(ByVal R As Range)
   
    If Not Intersect(R, Range("e23")) Is Nothing And R.Count = 1 Then 'présent(s) au RdV
    qui_sera_au_rdv.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("m9")) Is Nothing And R.Count = 1 Then 'en vente depuis
    agent_indpt.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("o9")) Is Nothing And R.Count = 1 Then 'en vente depuis
    agence.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("r9")) Is Nothing And R.Count = 1 Then 'en vente depuis
    notaire.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("e11")) Is Nothing And R.Count = 1 Then 'en vente depuis
    prepa_mandat.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("r11")) Is Nothing And R.Count = 1 Then 'en vente depuis
    en_vente_depuis.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("v14")) Is Nothing And R.Count = 1 Then 'visites et retours
    visites_retours.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("v17")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    pkoi_pas_vendu.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("m35")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    Quantité.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("m35")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    Quantité.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("o35")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    Quantité.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("r35")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    Quantité.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("t35")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    Quantité.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("v35")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    Quantité.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("x35")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    Quantité.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("e9")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    oui_non.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("e19")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    oui_non.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("i4")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    oui_non.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("g7")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    oui_non.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("k7")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    oui_non.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("t9")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    oui_non.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("v9")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    oui_non.Show
    Range("a1").Activate
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Et j'en ai à lui ajouter LOL
J'essaie de le raccourcir mais je n'y arrive pas

Pourriez-vous m'aider (comme d'hab ,

En vous souhaitant à toutes et à tous un beau WE, je vous remercie d'être tjrs là.
Amicalement,
arthour973

 

[Staple1600]

Re, Bonjour Si...

@arthour973
Juste pour le fun , mon interprétation de la chose
(à tester sur un classeur contenant 4 userfoms nommés: UserForm1,UserForm2,UserForm3 et UserForm4)
A mettre dans le code de la feuille

Private Sub Worksheet_SelectionChange(ByVal R As Range)
Application.ScreenUpdating = False
If R.Count <> 1 Then Exit Sub
Dim U$, vAdr, vUsf
vAdr = Array("A1", "B1", "C1", "D1")
vUsf = Array("UserForm1", "UserForm2", "UserForm3", "UserForm4")
X = R.Address(0, 0)
On Error Resume Next
U = Application.Index(vUsf, Application.Match(X, vAdr, 0))
VBA.UserForms.Add(U).Show
Application.ScreenUpdating = True
End Sub

PS: Purement à vocation illustrative, n'est donc pas une solution finalisée à la question
Je le laisse le soin de finaliser si le cœur t'en dit, arthour973

NB: Si tu as beaucoup d'userforms, le code ci-dessus ne sera pas forcément des plus pratique.

 

[Usine à gaz]

Merci JM
Je vais regarder.

 

[Si...]

Re

Nota : j'ai souvent lu que trop de sélects n'était pas bon ?

On n'a pas les mêmes lectures ?

Un des avantages du Select Case est, quand le cas est trouvé, de sortir immédiatement sans se préoccuper des autres donc d'éviter des interférences éventuelles.

Ici la répétition de [A1].Select vient de ce que l'on ne sait pas ce qui se passe à la fermeture du formulaire appelé donc pourrait être enlevé.

Staple, j'ai donné une réponse à la demande sans savoir ce qu'il y a autour donc je ne suis pas parti voir ailleurs si tu y étais

 

[Usine à gaz]

Re JM,

J'ai fait le fichier test mais il ne se passe rien.

Rectification :
ça marche si je clique en A1 mais pas pour A2, 3 et 4

Re-rectif LOL (j'arrête le cognac) : c'était pas A2, 3 et 4 mais B1, C1 et D1
ça marche parfaitement
Fichier en pièce jointe.

Merci pour ce code très court

 

[Usine à gaz]

Re
On n'a pas les mêmes lectures ?
Un des avantages du Select Case est, quand le cas est trouvé, de sortir immédiatement sans se préoccuper des autres donc d'éviter des interférences éventuelles.
Ici la répétition de [A1].Select vient de ce que l'on ne sait pas ce qui se passe à la fermeture du formulaire appelé donc pourrait être enlevé.

Merci de m'avoir répondu.
Dans mon fichier, les UserForms permettent juste la sélection d'un texte ou d'un nombre ..... le retour à A1 en select ou activate permet juste de sortir de la cellule cliquée affichant un UserForm.

 

[Staple1600]

Re

@arthour973

Re JM,
Rectification :
ça marche si je clique en A1 mais pas pour A2, 3 et 4

Re-rectif LOL (j'arrête le cognac) : c'était pas A2, 3 et 4 mais B1, C1 et D1
ça marche parfaitement
Fichier en pièce jointe.

Merci pour ce code très court

J'allais t'écrire qu'il fallait bien lire ceci
vAdr = Array("A1", "B1", "C1", "D1")

Mais je vois que tu viens de comprendre et d'éditer ton message

NB: Relire le message où j'ai posté le code (j'ai ajouté une précision en bas de message)

 

[Usine à gaz]

Oui J'ai vu JM et je stoppe le cognac du matin

Ton code est très court et fonctionne bien.
Il me reste i, petit truc que je n'arrive pas à faire :

"Range("A1").Activate "

Il faudrait que ce code soit actif que si je sélectionne "A2", "B2", "C2", "D2" (j'ai modifié 1 en 2)
Je remets le fichier en pièce jointe
Merci JM
Amicalement,
arthour973

 

[Staple1600]

Re

Dans ton exemple, les userforms sont identiques (donc cela perds de son intérêt, non?)
Sinon pour cette histoire de A1
Il suffit d'ajouter ceci dans le code des userforms, non ?
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Application.Goto Range("A1")
End Sub
ou
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Range("A1").select
End Sub
ou encore
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
[A1].Select
End Sub

 

[Usine à gaz]

Oui, bien sûr, il suffit de le mettre dans le code de l'UserForm

 

[Si...]

Re
Mais quand je vois le nombre conséquent d'userform dans ton classeur, mes narines comment à sentir le gaz

pour le Fun qui évite d'avoir du gaz dans l'eau ...

 

[Staple1600]

Re

@arthour973
Suggestion en passant
Tu n'as pas envisagé l'emploi d'un seul userform avec un contrôle Multipage?
Ou un seul userform qui se redimensionne selon la cellule active ?
(affichant/masquant donc les parties de l'userform selon les usages dépendants de la cellule active)

 

[Usine à gaz]

pour le Fun qui évite d'avoir du gaz dans l'eau ...

Bon sang de bon sang tu es un magicien et j'y arriverai jamais = ça me dégoute LOL
Super Si, est Si léger
Je n'y aurait jamais pensé.
MerSI vraiment

 

[Usine à gaz]

Re

@arthour973
Suggestion en passant
Tu n'as pas envisagé l'emploi d'un seul userform avec un contrôle Multipage?
Ou un seul userform qui se redimensionne selon la cellule active ?
(affichant/masquant donc les parties de l'userform selon les usages dépendants de la cellule active)

LOL je suis vraiment dégouté cette fois-ci. je ne sais pas faire ça mais je vais essayer de voir comment ça marche

 

[Usine à gaz]

pour le Fun qui évite d'avoir du gaz dans l'eau ...

Juste 2 petits souSI :

- dans le fichier test, les cellules à cliquer se suivent mais ce n'est pas le cas dans mon fichier de travail,
- l'affichage de la liste index est toujours sur le même format et nous avons besoin de voir tout le texte. Ce serait bien que la taille de la liste s'adapte au texte le plus long.

Voir fichier joint.
Mais ton code est super