XL 2010 Cellule avec menu déroulant

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.
 

dauof

XLDnaute Nouveau
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
Bonjour et merci de votre retour, voici le code que je veux mettre en place:

Code:
If Not Intersect(Target, Range("B2")) Is Nothing Then
          
        Set Plage_de_Recherche = [Ajustement_calendaire]
        Set Cel_Trouvée = Plage_de_Recherche.Cells.Find(what:=Target.Value, LookAt:=xlWhole)
        Référence1 = Cel_Trouvée.Offset(, 1).Value
        End If
      
        If Not Intersect(Target, Range("C2")) Is Nothing Then
   
        Set Plage_de_Recherche = [Garantie_minimum]
        Set Cel_Trouvée = Plage_de_Recherche.Cells.Find(what:=Target.Value, LookAt:=xlWhole)
        Référence2 = Cel_Trouvée.Offset(, 1).Value
        End If
      
              
        Select Case Référence1 & Référence2
      
     
        Case 1

                    ActiveSheet.Rows("43:52").Hidden = False
                    ActiveSheet.Rows("76:85").Hidden = False
                  
                    ActiveSheet.Rows("53:55").Hidden = True
                    ActiveSheet.Rows("177:179").Hidden = True
                  
                    ActiveSheet.Columns("AP:XFD").Hidden = True
                    ActiveSheet.Rows("192:1048576").Hidden = True
                  
                    MsgBox "Ajustement calendaire:" & Chr(13) & Chr(13) & "Le fractionnement mensuel est impossible."
                  
        Case Else
      
                    ActiveSheet.Rows("43:52").Hidden = True
                    ActiveSheet.Rows("76:85").Hidden = True
                  
                    ActiveSheet.Rows("53:55").Hidden = True
                    ActiveSheet.Rows("177:179").Hidden = True
                  
                    ActiveSheet.Columns("AP:XFD").Hidden = True
                    ActiveSheet.Rows("192:1048576").Hidden = True
                  
                    MsgBox "Pas d'ajustement calendaire:" & Chr(13) & Chr(13) & "Le fractionnement mensuel est possible."
     
        End Select
      
    If Not Intersect(Target, Range("C2")) 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("B2").Value, LookAt:=xlWhole).Offset(, 1).Value
End If  
        fin:
With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub

Je ne comprends pas pourquoi ça ne fonctionne pas,

sachant que je veux bloquer le changement de la cellule B2 sur la cellule C2 prend la valeur "NON".

merci de votre aide.
 
Dernière édition:

dauof

XLDnaute Nouveau
Re..
Avec ce code incomplet et sans classeur avec la réelle structure, il sera difficile de faire quelque chose....

Merci de votre retour,

le code n'est certainement pas bien fait, je ne fais que débuter dans VBA, dans le fichier joint, mais ce que je veux, c'est ceci:

Si A1 prend la valeur V1:
Exécuter le code pour cette valeur.
Bloquer A2, aucune valeur ne pourra être choisi;

Si A1 prend la valeur V2:
Exécuter le code pour cette valeur.
Débloquer ensuite A2 pour pouvoir choisir la valeur souhaitée.
exécuter le code correspondant à la valeur choisie dans A2.

Et vice versa, si A2 prend la valeur 2016:
Exécuter le code pour cette valeur.
Bloquer A1, aucune valeur ne pourra être choisi;

Si A2 prend la valeur 2017:
Exécuter le code pour cette valeur.
Débloquer ensuite A1 pour pouvoir choisir la valeur souhaitée.
exécuter le code correspondant à la valeur choisie dans A1.
 

Pièces jointes

  • test_dauof V1.xlsm
    20.5 KB · Affichages: 12

Jacky67

XLDnaute Barbatruc
Merci de votre retour,

le code n'est certainement pas bien fait, je ne fais que débuter dans VBA, dans le fichier joint, mais ce que je veux, c'est ceci:

Si A1 prend la valeur V1:
Exécuter le code pour cette valeur.
Bloquer A2, aucune valeur ne pourra être choisi;

Si A1 prend la valeur V2:
Exécuter le code pour cette valeur.
Débloquer ensuite A2 pour pouvoir choisir la valeur souhaitée.
exécuter le code correspondant à la valeur choisie dans A2.

Et vice versa, si A2 prend la valeur 2016:
Exécuter le code pour cette valeur.
Bloquer A1, aucune valeur ne pourra être choisi;

Si A2 prend la valeur 2017:
Exécuter le code pour cette valeur.
Débloquer ensuite A1 pour pouvoir choisir la valeur souhaitée.
exécuter le code correspondant à la valeur choisie dans A1.

Re..
Je n'ai pas compris quel doit être le résultat.
Dans le classeur en PJ, il y a différentes "case" il t'appartient de récupérer ou d'ajouter celle qui t'intéresse pour obtenir ce que tu souhaites.
 

Pièces jointes

  • test_dauof V1.xlsm
    23.9 KB · Affichages: 20

dauof

XLDnaute Nouveau
Re..
Je n'ai pas compris quel doit être le résultat.
Dans le classeur en PJ, il y a différentes "case" il t'appartient de récupérer ou d'ajouter celle qui t'intéresse pour obtenir ce que tu souhaites.
Merci de votre retour et implication.

C'est à peu près cela, mais dans le fichier que vous m'avez envoyé, si A1 prend la valeur V2, A2 n'est pas bloquée, il faut qu'on ne puisse pas modifier sa valeur, voir envoyer un message qui alerte le blocage de celle-ci.

Tant que A1 prend la valeur V2, A2 ne peut être saisie ni modifiée.

Et vice versa pour A2, tant que A2 prend la valeur 2016, A1 ne peut être saisie ni modifiée.

Merci de votre précieuse aide.
 

dauof

XLDnaute Nouveau
Re..
Une dernière proposition avec protection de la feuille pour éviter la saisie manuelle en cas de "V1"ou "2016"
Merci pour le fichier, il reste un point essentiel, les cellules se bloquent sans problème, mais si on saisie dans une autre cellule autre que la A1 et A2, et bien ça débloque les cellules/
Si A1 était bloquée, elle devient débloquée et vice vesra.

Merci de votre retour.
 

dauof

XLDnaute Nouveau

C'est nettement mieux qu'avant, je suis désolé de vous déranger encore une fois, mais le fait de choisir la valeur V1 dans la cellule A1, cela active la protection de toute la cellule, on n'a plus accès au menu déroulant pour utiliser par exemple la fonctionnalité "format de la cellule, il faut ôter la protection de la feuille entière à chaque fois.

Merci de votre précieuse aide.
 

Jacky67

XLDnaute Barbatruc
re..
La mise en forme des cellules A1;A2 doit être faite feuille non protéger.
Elle est faite une fois seulement non?
ou alors remplacer le code dans le thisworkbook par
Code:
Private Sub Workbook_Open()
Worksheets("Feuil1").Protect , DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True, UserInterfaceOnly:=True
End Sub
Et enregistrer pour que cela prenne effet
Dans la dernière version
il faut supprimer la ligne
On error goto 0
 

dauof

XLDnaute Nouveau
re..
La mise en forme des cellules A1;A2 doit être faite feuille non protéger.
Elle est faite une fois seulement non?
ou alors remplacer le code dans le thisworkbook par
Code:
Private Sub Workbook_Open()
Worksheets("Feuil1").Protect , DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True, UserInterfaceOnly:=True
End Sub
Et enregistrer pour que cela prenne effet
Dans la dernière version
il faut supprimer la ligne
On error goto 0

Merci de votre retour,

la protection de la feuille se remet à chaque fois. malgré les modifications que vous m'avez suggérées.
 

dauof

XLDnaute Nouveau
Re..
Certes, c'est obligé dans ce cas pour éviter les saisies manuelles, mais la mise en forme reste accessible.
Merci de votre retour,

le problème qui va se poser c'est quand je voudrais protéger ma feuille avec un mot de passe, un conflit apparaît entre le code qui protège à chaque fois la feuille et ma propre protection que je souhaiterai mettre en place une fois que le fichier est fini.

Merci de votre aide.
 

Jacky67

XLDnaute Barbatruc
Re..
On ne peut pas avoir le beurre et .........
Dans ce cas la protection doit se mettre en place par vba
Les codes de protection dans le thisworkbook et à la fin du code de feuil1
Exemple ici avec le mot de passe ==>fouad
Code:
Worksheets("Feuil1").Protect "fouad", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True, UserInterfaceOnly:=True
NB: Les cellules qui doivent être modifiables ne sont pas verrouillées. Seules, les cellules verrouillées seront protégées, dans ce cas A1 et A2
 

Pièces jointes

  • test_dauof V2.xlsm
    22.8 KB · Affichages: 19
Dernière édition:

Discussions similaires

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

Statistiques des forums

Discussions
311 724
Messages
2 081 936
Membres
101 844
dernier inscrit
pktla