XL 2010 Cellule avec menu déroulant

D

dauof

XLDnaute Nouveau
Bonjour,

je suis débutant dans excel et VBA et j'aurai besoin de votre aide,
voici ce bout de code:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    ' si cellule vide alors on force un "Undo" de l'application
    If Target.Value = "" Then
        Application.Undo
        Exit Sub
    End If
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        Dim Cel_Trouvée As Range, Plage_de_Recherche As Range, Référence As Integer
        Set Plage_de_Recherche = [Test]
        Set Cel_Trouvée = Plage_de_Recherche.Cells.Find(what:=Target.Value, LookAt:=xlWhole)
        Référence = Cel_Trouvée.Offset(, 1).Value
        Select Case Référence
            Case 1
                ActiveSheet.Rows("60:131").Hidden = True
                ActiveSheet.Rows("132:149").Hidden = False
            Case 2
                ActiveSheet.Rows("60:131").Hidden = False
                ActiveSheet.Rows("132:149").Hidden = True
            Case Else
                ActiveSheet.Rows("60:131").Hidden = False
                ActiveSheet.Rows("132:149").Hidden = False
        End Select
    End If
End Sub

j’aurai besoin de savoir comment dois-je m'y prendre pour faire la même vérification sur une autre cellule dans la même feuille, en exécutant un autre bout de code (des cases).

Merci de votre aide.
 
Trier par date Trier par votes
Jacky67

Jacky67

XLDnaute Barbatruc
Bonjour,
Une possibilité.....​
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
' si cellule vide alors on force un "Undo" de l'application
If Target.Value = "" Then
  Application.Undo
  GoTo fin
End If
Dim Cel_Trouvée As Range, Plage_de_Recherche As Range, Référence As Integer
'Si plage identique mettre ici==>Set Plage_de_Recherche = [Test]
If Not Intersect(Target, Range("A1")) Is Nothing Then
  Set Plage_de_Recherche = [Test]  'supprimer si plage identique
  Set Cel_Trouvée = Plage_de_Recherche.Cells.Find(what:=Target.Value, LookAt:=xlWhole)
  Référence = Cel_Trouvée.Offset(, 1).Value
  Select Case Référence
    Case 1
      ActiveSheet.Rows("60:131").Hidden = True
      ActiveSheet.Rows("132:149").Hidden = False
    Case 2
      ActiveSheet.Rows("60:131").Hidden = False
      ActiveSheet.Rows("132:149").Hidden = True
    Case Else
      ActiveSheet.Rows("60:131").Hidden = False
      ActiveSheet.Rows("132:149").Hidden = False
  End Select
End If
If Not Intersect(Target, Range("B1")) Is Nothing Then  'autre cellule
  Set Plage_de_Recherche = [Test]  'ou autre plage ou 'supprimer si plage identique
  Set Cel_Trouvée = Plage_de_Recherche.Cells.Find(what:=Target.Value, LookAt:=xlWhole)
  Référence = Cel_Trouvée.Offset(, 1).Value  ' ou autre offset
  Select Case Référence
    Case 1
      'action
    Case 2
      'action
    Case Else
      'action
  End Select
End If
fin:
With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
D

dauof

XLDnaute Nouveau
Jacky67 à dit:
Bonjour,
Une possibilité.....​
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
' si cellule vide alors on force un "Undo" de l'application
If Target.Value = "" Then
  Application.Undo
  GoTo fin
End If
Dim Cel_Trouvée As Range, Plage_de_Recherche As Range, Référence As Integer
'Si plage identique mettre ici==>Set Plage_de_Recherche = [Test]
If Not Intersect(Target, Range("A1")) Is Nothing Then
  Set Plage_de_Recherche = [Test]  'supprimer si plage identique
  Set Cel_Trouvée = Plage_de_Recherche.Cells.Find(what:=Target.Value, LookAt:=xlWhole)
  Référence = Cel_Trouvée.Offset(, 1).Value
  Select Case Référence
    Case 1
      ActiveSheet.Rows("60:131").Hidden = True
      ActiveSheet.Rows("132:149").Hidden = False
    Case 2
      ActiveSheet.Rows("60:131").Hidden = False
      ActiveSheet.Rows("132:149").Hidden = True
    Case Else
      ActiveSheet.Rows("60:131").Hidden = False
      ActiveSheet.Rows("132:149").Hidden = False
  End Select
End If
If Not Intersect(Target, Range("B1")) Is Nothing Then  'autre cellule
  Set Plage_de_Recherche = [Test]  'ou autre plage ou 'supprimer si plage identique
  Set Cel_Trouvée = Plage_de_Recherche.Cells.Find(what:=Target.Value, LookAt:=xlWhole)
  Référence = Cel_Trouvée.Offset(, 1).Value  ' ou autre offset
  Select Case Référence
    Case 1
      'action
    Case 2
      'action
    Case Else
      'action
  End Select
End If
fin:
With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub
Cliquez pour agrandir...
Merci de votre aide,

j'ai essayé mais cela ne marche pas, voici mon code pour la deuxième partie:

Code: 
      ElseIf Not Intersect(Target, Range("D1")) Is Nothing Then
     
        Set Plage_de_Recherche = [Année]
        Set Cel_Trouvée = Plage_de_Recherche.Cells.Find(what:=Target.Value, LookAt:=xlWhole)
        Référence = Cel_Trouvée.Offset(, 1).Value
       
        Select Case Référence
       
        Case 1
       
                    ActiveSheet.Rows("57").Hidden = True
                   
        Case 2
                    ActiveSheet.Rows("57").Hidden = False
       
        Case Else
                    ActiveSheet.Rows("57").Hidden = False
       
        End Select
       
      End If
Je ne sais pas si j'ai raté quelque chose.

merci de votre aide
 
Vote positif 0 Vote négatif
D

dauof

XLDnaute Nouveau
Jacky67 à dit:
Re..
Et qu'est qui ne fonctionne pas ?
Chez moi, la macro fait exactement ce qui lui est demandé
Masquer/afficher ligne 57
Masquer/afficher ligne 60: 131 et 132:149
Et ne pas pouvoir effacer une cellule non vide
Cliquez pour agrandir...
Merci de votre retour,

En fait mon fichier est beaucoup plus lourd que ça, je vais vérifier d'où vient le problème et vous tiens au courant.

Bon weekend à vous
 
Vote positif 0 Vote négatif
D

dauof

XLDnaute Nouveau
Bonjour, j'ai réussi à régler mon problème, merci de votre aide,

J'ai une autre question, comment dois-je procéder pour tester le contenu de deux cellules (ayant un menu déroulant) avant d’exécuter mes cas?

Merci de votre aide.
 
Vote positif 0 Vote négatif
Jacky67

Jacky67

XLDnaute Barbatruc
Re..
La variable "Référence "= Cel_Trouvée.Offset(, 1).Value
Contrôler dans un projet la valeur d'une cellule préalablement saisie dans un tableau est sujet a monter une usine à gaz.
Il vaudrait mieux faire une contrôle à la saisie de cette plage de cellules, plutôt qu'a son utilisation.
Ceci n'est que mon avis, mais c'est comme cela que je procéderais
Mais je n'ai peut-être pas compris ce que doit être le résultat.​
 
Vote positif 0 Vote négatif
D

dauof

XLDnaute Nouveau
Jacky67 à dit:
Re..
La variable "Référence "= Cel_Trouvée.Offset(, 1).Value
Contrôler dans un projet la valeur d'une cellule préalablement saisie dans un tableau est sujet a monter une usine à gaz.
Il vaudrait mieux faire une contrôle à la saisie de cette plage de cellules, plutôt qu'a son utilisation.
Ceci n'est que mon avis, mais c'est comme cela que je procéderais
Mais je n'ai peut-être pas compris ce que doit être le résultat.​
Cliquez pour agrandir...
Merci de votre retour, voici un exemple de ce que je dois tester:

Si A1 ="a" et A2 = "b" alors faire le code 1.
Si A1 = "b" et A2 = "c" alors faire le code 2.
A1 et A2 étant des cellules différentes contenant des menus déroulants différents.
etc...
 
Vote positif 0 Vote négatif
Jacky67

Jacky67

XLDnaute Barbatruc
dauof à dit:
C'est parfait,

Un autre problème se pose dans le cas suivant:

Si par exemple A1 = a alors figer la Cellule A2.

Merci de votre aide précieuse
Cliquez pour agrandir...
Re...
Tester avec
Code: 
If Not Intersect(Target, Range("A1")) Is Nothing Then
  Référence1 = [Valeurs].Cells.Find(what:=Target.Value, LookAt:=xlWhole).Offset(, 1).Value
  Référence2 = [Année].Cells.Find(what:=Range("A2").Value, LookAt:=xlWhole).Offset(, 1).Value
End If
Idem avec A2 si besoin
 
Vote positif 0 Vote négatif

Discussions similaires

chaelie2015
  • Question
XL 2013 Réduire un code
Réponses
0
Affichages
221
chaelie2015
chaelie2015
B
  • Résolu(e)
Microsoft 365 Besoin d'aide pour faire fonctionner 2 codes VBA ensemble
Réponses
2
Affichages
136
BenExcel
B
R3n0W
  • Résolu(e)
XL 2016 If Not xRgSel Is Nothing Then --> Ne marche pas
Réponses
10
Affichages
159
R3n0W
R3n0W
T
  • Question
Microsoft 365 Cacher / détailler certaines colonnes dans certains onglets avec mot de passe
Réponses
6
Affichages
379
ThierryP
T
D
  • Question
Microsoft 365 Application.WorksheetFunction.VLookup ne fonctionne pas au delà de 8500 lignes
Réponses
4
Affichages
297
DimiJuju
D
U
  • Question
Autres [RÉSOLU] Faire afficher ligne sur tout le classeur par double clic et la faire maquer à l’enregistrement
Réponses
11
Affichages
403
un internaute
U
patricktoulon
  • Question
Autres Petite mise a jour (exceptionnellement pour cp4) du calendar V4.1(OLDVERSION)
2
Réponses
21
Affichages
412
patricktoulon
patricktoulon
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Code afficher/Masquer problème
Réponses
10
Affichages
225
chaelie2015
chaelie2015
petitbuzuc
  • Question
XL 2016 Aide pour maj auto de la date + selection multiple dans une liste déroulante
Réponses
5
Affichages
226
fanch55
fanch55
U
  • Question
Autres [RÉSOLU] Pour faire afficher colonne F par double clic dans tout le classeur
Réponses
3
Affichages
358
vgendron
vgendron

Membres actuellement en ligne

4 membres et 47 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 177
Messages
2 085 972
Membres
103 073
dernier inscrit
MSCHOE16