XL 2013 peut-on raccourcir ce code ?

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour à touts et à tous,

J'ai le code ci-dessous :
Code:
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 :confused:

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

XLDnaute Barbatruc
Re

Pour raccourcir un code, mieux vaut pouvoir tester d'abord le code original, non ?
Histoire de vérifier que le code raccourci produit le même résultat.

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

Déjà pourquoi ce Range("A1").Activate répété n fois ?!?
 

Roland_M

XLDnaute Barbatruc
re, voilà !

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

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Re Bonjour Roland, JM

J'ai juste modifié le code comme suit :
Code:
Private Sub Worksheet_SelectionChange(ByVal R As Range)
Application.EnableEvents = False: Application.ScreenUpdating = False
If R.Count <> 1 Then Exit Sub
If Not Intersect(R, Range("e23")) Is Nothing Then qui_sera_au_rdv.Show: [a1].Activate
If Not Intersect(R, Range("m9")) Is Nothing Then agent_indpt.Show: [a1].Activate
If Not Intersect(R, Range("o9")) Is Nothing Then agence.Show: [a1].Activate
If Not Intersect(R, Range("r9")) Is Nothing Then notaire.Show: [a1].Activate
If Not Intersect(R, Range("e11")) Is Nothing Then prepa_mandat.Show: [a1].Activate
If Not Intersect(R, Range("r11")) Is Nothing Then en_vente_depuis.Show: [a1].Activate
If Not Intersect(R, Range("v14")) Is Nothing Then visites_retours.Show: [a1].Activate
If Not Intersect(R, Range("v17")) Is Nothing Then pkoi_pas_vendu.Show: [a1].Activate
If Not Intersect(R, Range("m35, o35, r35, t35, v35, x35")) Is Nothing Then Quantité.Show: [a1].Activate
If Not Intersect(R, Range("e9, e19, i4, g7, k7, t9, v9")) Is Nothing Then oui_non.Show: [a1].Activate
Application.EnableEvents = True: Application.ScreenUpdating = True
End Sub
Car "Range("a1").Activate" ne doit s'exécuter que si clic sur les cellules appelant les userForm.
Bon WE
amicalement,
arthour973
 

Si...

XLDnaute Barbatruc
Bon_jour
un truc "Select" à ne pas négliger :
VB:
Private Sub Worksheet_SelectionChange(ByVal R As Range)
  Application.EnableEvents = 0
  Select Case R.Address
    Case "$E$23": qui_sera_au_rdv.Show: [A1].Select
    Case "$M$9": agent_indpt.Show: [A1].Select
    Case "$O$9": agence.Show: [A1].Select
    Case "$R$9": notaire.Show: [A1].Select
    Case "$E$11": prepa_mandat.Show: [A1].Select
    Case "$R$11": en_vente_depuis.Show: [A1].Select
    Case "$V$14": visites_retours.Show: [A1].Select
    Case "$V$17": pkoi_pas_vendu.Show: [A1].Select
    Case "$M$35", "$O$35", "$R$35", "$T$35", "$V$35", "$X$35": Quantité.Show: [A1].Select
    Case "$E$9", "$E$19", "$i$4", "$g$7", "$k$7", "$T$9", "$V$9": oui_non.Show: [A1].Select
  End Select
  Application.EnableEvents = 1
End Sub
 

Discussions similaires

  • Résolu(e)
XL 2021 macro
Réponses
9
Affichages
428

Statistiques des forums

Discussions
311 737
Messages
2 082 036
Membres
101 878
dernier inscrit
1475214