Private Sub Worksheet_SelectionChange sous conditions

Question

Bonjour à tous
Mon problème est le suivant:
Sur une feuille de planning j'ai une date a changer une fois sur deux (+ 2ans) par rapport a ma date de saisie. Exemple 
1: date de saisie:02/02/17  échange deshy à faire le 02/02/19
2: date de saisie:02/02/18 échange deshy toujours à faire le 02/02/19
3: date de saisie:02/02/19 échange deshy à faire le 02/02/21
Etc…..
A savoir que ma cellule "date de saisie" change régulièrement de place car j'insère des lignes. Ceci dit elle est toujours dans la même colonne.

Mon code:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Réponse As String
If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
  If ActiveCell.Value = 0 Then
  Application.EnableEvents = False
  Else
  Application.EnableEvents = True
  End If
 Réponse = MsgBox("avez-vous changé le deshydrateur", vbYesNoCancel, "echeance deshy")
  If Réponse = vbYes Then
"ma macro qui finit par activecell.clearcontent pour pouvoir remplir ma cellule"
  End If
  If Réponse = vbNo Then
  "ma deuxième macro qui finit par activecell.clearcontent pour pouvoir remplir ma cellule"
  End If
  If Réponse = vbCancel Then
  Exit Sub
  End If
End If
End Sub

Mon code ne marche pas si quelqu'un à une idée, elle sera bienvenue car apprenti débutant en VBA je commence à avoir mal à la tête.
Merci à tous.

Configuration: Windows / Firefox 57.0

      EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ici : ICI 

Merci d'y penser dans tes prochains messages.

f894009 · Answer

Bonjour,

pourquoi avez vous mis ceci:

        If ActiveCell.Value = 0 Then
            Application.EnableEvents = False
        Else
            Application.EnableEvents = True
        End If

domimeca · Answer

Bonjour f894009
Au départ seule ma cellule A1 était concernée. Au fur et à mesure de l'utilisation de ma feuille avec les insertion vont changer A1 en A10,A11 etc et il faudra qu'elle marche ici. L'idée était d'affecter de A1 à A2000 et si la cellule est vide, lorsque on la sélectionne rien ne se passe. Si vous avez une idée pour faire "circuler" l'appli de A1 qui en devenant A21 marche encore je suis preneur.N.B. dans ce dernier cas l'appli se fera sur toutes les cellules entre A1 et A21.
J'espère être arrivé à me faire comprendre.

domimeca · Answer

Je vais essayer d'être plus clair.
Mon classeur permet d'obtenir un planning annuel d'entretien de climatisation sur des autocars. Sur certains véhicules on change le déshydrateur chaque année donc à chaque fois et sur d'autres seulement une fois sur deux, donc tous les deux ans. Lorsque je rentre ma date de dernière intervention, msgbox. "avez vous changé le déshydrateur?" 
Si "oui" l’échéance "prochain changement de deshy" passe automatiquement "date d'intervention + 2 ans ou plus 1 an" suivant le type de véhicule.
Si "non" l’échéance "prochain changement de deshy" ne change pas.
Le problème est qu'a chaque fois que je crée un nouveau véhicule je crée une insertion, donc ma cellule A1 va devenir A2 et je voudrais que l'appli marche aussi sur cette dernière.

yg_be · Answer

bonjour, et ainsi?
Range("A:A") au lieu de Range("A1:A10")(modifié sur suggestion de f894009, merci et bonjour)

pourquoi utilises-tu _SelectionChange?  moi je suggère _Change

domimeca · Answer

Voici le lien de mon fichier:https://www.cjoint.com/c/GLjnEq8xULL
c'est un fichier d'essais.
Pour l'instant il n'y a pas l'appli dont je vous parle, je faisais des essais sur un classeur lambda, et j'aurais essayé de l'adapter.  Je pensait mettre cette sub() sur la feuil1 qui une fois dupliquée se retrouverais sur chaque feuilles client. Sur la feuille client seule la cellule "dernière inter" sera déprotégée. P.S. ne tenez pas compte des différentes échéance d'entretien, seule "1an" sera utilisée je vais supprimer les autres et suggérerez "chaque fois" ou "une fois sur deux" dans la cellule "échange deshy  prévu" lors de l'enregistrement du nouveau véhicule.
J'espère avoir été presque clair, en tout cas merci beaucoup à tous ceux qui se penche sur mon problème.

f894009 · Answer

Re,

Quel est le rapport entre le code que vous avez mis dans votre demande au debut et ce code qui est dans chaque feuille client? Que doit faire ce code car correspond a rien ???????????????????????????

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sh As Worksheet
  If Intersect(Range("J3"), Target) Is Nothing Then Exit Sub
  For Each Sh In Worksheets
      If Sh.Range("E1").Value = Target.Value Then
         Sh.Activate
         Sh.Range("A1").Activate
      End If
  Next Sh
End Sub

domimeca · Answer

Oups! En effet il ne sert à rien, c'est à force de "copier coller" par rapport à un ancien fichier qui nommait mes nouvelles feuilles que j'avais fait il y a très longtemps. Je voulais mettre à sa place celle du début mais bien entendu en changeant Range (A1:A10) par (G9) et ma macro aller récupérer la valeur de (N9) qui aurait été =MOIS.DECALER(G9;24). Mes codes sont probablement assez brouillon, c'est le résultat de mon noviciat.Encore merci mille fois de vous pencher sur mon problème.

domimeca · Answer

Voici donc mon fichier final:https://www.cjoint.com/c/GLjvjNuPctL
Le mot de passe pour déverrouiller feuille et structure est "juju"
Le mot de passe demandé pour supprimer un client est "dominique"
Comme vous pourrez le constater, sur ma feuille client lorsque je change la date d'intervention, pour les véhicules ou l'échange deshy est prévu tous les deux ans, la date d’échéance augmente de eux ans, ce qui est logique or il faudrait qu'elle ne change qu'une fois sur deux. Je pourrais peut  être mettre une formule par rapport à aujourd'hui mais cela dépendra du jour ou on fait la saisie. C'est pour cela que je préfère la MsgBox comme sur mon essais de code au début de cette discussion.
Encore merci pour votre patience avec les débutants.

domimeca · Answer

Bonjour à vous deux,
    Pour répondre à yg_be, c'est évident mais le petit luxe que je voulais apporter à ce planning était de rentrer seulement la date de la dernière intervention et tout se faisait automatiquement en répondant oui ou non à la question "avez-vous changé le deshy?"
  f894009, sur la feuille client la cellule "dernière inter." est libre d’accès. Ma macro partant de vbYes ou vbNo déprotègera et reprotégera ma feuille comme je l'ai déjà fait sur d'autre dans mon classeur.

domimeca · Answer

Donc si je comprends bien, une même cellule ne peut pas en conditionner deux autres avec chacune une formule différente?

domimeca · Answer

La dernière inter c'est la dernière fois que l'on fait une révision de la climatisation (chaque année car obligatoire) donc la prochaine révision sera un an après. Pour certains véhicules lors de cette révision annuelle on change le deshydrateur une fois sur deux. Pour les autres on le change à chaque fois.
Exemple pour "une fois sur deux":
1:le 10/12/2017 j'ai fais la révision annuelle et j'ai changé le deshydrateur (vbYes) donc ma prochaine révision annuelle (échéance) devra avoir lieu le 10/12/2018 mais je devrais changer le désydrateur (ech. deshy)le 10/12/2019.
2: le 15/12/2018 je fais la révision annuelle prévue mais je ne change pas le deshydrateur car pas arrivé à échéance (vbNo). Ma date (éch déshydrateur) reste inchangée (10/12/2019), ma prochaine échéance révision (échéance) sera le 15/12/2019. 
Ce jour il faudra que je fasse la révision obligatoire et que je change le deshy.

J'espère être arrivé à me faire comprendre.

domimeca · Answer

Le choix changement de deshy 1 fois sur deux ou chaque année se fait lors de l'enregistrement du véhicule après on ne peu plus le changer ou alors on supprime le véhicule et on le réenregistre. Il faut savoir que lorsqu'on change un deshy on fait obligatoirement une révision générale. Donc pas d’intérêt à connaître la date de ce dit changement. Si il y a une différence d'un ou deux mois entre les deux échéance pas de problème, lors de la prochaine révision tout se remettra dans l'ordre. Essayez d'enregistrer un nouveau véhicule bidon vous comprendrez plus facilement où je veux en venir. Sur la page client Querard il y a les deux sorte de véhicule.

domimeca · Answer

Ce qui m’intéresse surtout, c'est d'avoir une MsgBox vbYesNoCancel lorque je sélectionne une des cellule non vide dans la colonne G (à partir de G9) si vbYes ma formule de la cellule H contiguë sera G + 2ans  et si vbNo un copier collé valeur sur la cellule H contiguë afin de figer la date. Pour l'échange de formule ou effacement de formule j'ai déjà la macro, le tout c'est de pouvoir la lancer avec ma MsgBox

domimeca · Answer

Génial, Je viens d'essayer rapidement sur un classeur vierge, c'est exactement ce que je cherchais. Maintenant à moi de l'adapter à mon classeur, rajouter un bloc if si la valeur de la cellule H (RC[+1]) contiguë est =MOIS.DECALER(RC[-1];12) pour l'arrêter. puis mettre mes macros.

Encore milles mercis pour votre patience. 
Je ne ferais pas ça ce soir, mais je vous tiendrais au courant.

domimeca · Answer

Bonjour f894009
  ?? le code ne marche plus ce matin. Après des galères pour l'adapter à mon fichier par rapport à la cellule active et le bloc if pour Application.EnableEvents = False/True plus de réaction. Retour sur mon classeur vierge, rien non plus, aucune réaction. Voici la petite modif qui m'a permit de l'essayer hier soir:
Private Sub Worksheet_Change(ByVal Target As Range)    If Target.Count > 1 Then Exit Sub        If Not Application.Intersect(Target, Range("G9:G" & Range("G" & Rows.Count).End(xlUp).Row)) Is Nothing Then        Réponse = MsgBox("avez-vous changé le deshydrateur", vbYesNoCancel, "echeance deshy")        If Réponse = vbYes Then        Range("A5").Select            'ma macro qui finit par activecell.clearcontent pour pouvoir remplir ma cellule"        ElseIf Réponse = vbNo Then        Range("B5").Select                    'ma deuxième macro qui finit par activecell.clearcontent pour pouvoir remplir ma cellule"        End If    End IfEnd Sub

Que se passe-t'il? Avez-vous une idée?

domimeca · Answer

Bonjour.
     Désolé pour cette réaction tardive, mais les derniers événements météorologiques en Vendée m'ont privé d'internet pendant ces 4 jours. 
       Un problème que je n'avais pas anticipé. Pour pouvoir appliquer mes macros, il faudrait que je puisse trouver l'adresse de la dernière cellule modifiée, et sélectionner sa contiguë sur la colonne H donc sur la même ligne +1. Ceci en début d'application. Peut que quand je serais arrivé à corriger mon erreur de syntaxe, mon code marchera.
Ci dessous le code que je pensais pouvoir appliquer:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    Dim Saisie1 As Variant
    Saisie1=EDATE(RC[-1],12)
    
    If Not Application.Intersect(Target, Range("G9:G" & Range("G" & Rows.Count).End(xlUp).Row)) Is Nothing Then
    'j'annule l'application si ma cellule a déjà la formule + 12 mois par rapport à ma cellule de saisie d'intervention
           If ActiveCell.FormulaR1C1 = Saisie1 Then
           Application.EnableEvents = False
           Else
           Application.EnableEvents = True
           End If
           
           Réponse = MsgBox("avez-vous changé le deshydrateur", vbYesNoCancel, "echeance deshy")
        If Réponse = vbYes Then
           ActiveSheet.Unprotect Password:="juju"
       
           ActiveCell.FormulaR1C1 = "=EDATE(RC[-1],24)"
            
           ActiveSheet.Protect Password:="juju", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingRows:=True, AllowSorting:=True
        
        ElseIf Réponse = vbNo Then
        ActiveSheet.Unprotect Password:="juju"
        ActiveCell.Select
            With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
     ActiveSheet.Protect Password:="juju", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingRows:=True, AllowSorting:=True
           
        End If
    End If
End Sub




 L'erreur de syntaxe est manifestement au niveau de la valeur de ma variante.

domimeca · Answer

Bonjour yg_be
Ci-joint une capture d'écran qui je l’espère aidera a comprendre mon problème. (Ne tiens pas compte de la cellule liste H4, j'ai fait un montage pour faire apparaître la msgbox)


Pour le véhicule RT 253 LM lorsque je change la date "dernière inter" apparait (grâce à f894009 la MsgBox. 
Si je clique oui, la date "échéance deshy H augmente de deux ans par rapport à ma dernière inter  
(MOIS.DECALER G9;24). 
Si je clique non, elle reste inchangée (copier,collé valeur G9). 
Même chose pour le véhicule AF 258 DE. 
Pour le véhicule AZ 853 GF "échéance deshy (H10) la formule est MOIS.DECALER(G10;12). Lorsque on change la "dernière inter" aucune MsgBox n'apparait car on ne modifie jamais cette formule c'est toujours + un an au même titre que toute les cellules de la colonne I. On fait une révision de la climatisation des véhicules chaque année, mais pour certains (cellule échéance en bleu) on change le deshy seulement une fois sur deux. 
Mon problème:dès que j'ai changé la date je suis obligé de sortir de la cellule pour la valider et donc faire apparaître la MsgBox. Pour pouvoir changer ou supprimer la formule de ma cellule "H" attenante il faut qu'elle devienne "ActiveCell". L'autre problème est que au fil des enregistrements de nouveaux véhicules, par système d'insertion de ligne, le couple G9 H9 va devenir G10 H10, puis G11 H11 etc. Donc je pensais à chaque application déterminer la nouvelle adresse de la cellule H par rapport à la cellule G que l'on vient de modifier et la sélectionner (pour la mettre en ActiveCell) et insérer ou pas ma formule. Cependant, si la formule qui se trouve déjà dedans est (MOIS.DECALER(G"";12)) un bloc If pour que l'application ne se lance pas. 
Tu trouvera mon fichier ici: N.B. le mot de passe unique pour déverrouiller la structure du Classeur et la protection de la feuille est:"juju"
https://www.cjoint.com/c/GLopgJforsL

domimeca · Answer

Bonjour yg_be,
      Je voudrais que ma cellule H attenante change de date une fois sur deux quand je saisis une date de "dernière inter". Lorsque je clique  "oui" elle rajoute deux ans  par rapport à la cellule G et lorsque je clique "non" elle reste à son ancienne valeur. Cependant si elle  a déjà une formule ou sa valeur correspond à G + 1 an, l'application ne se lance pas, la MsgBox n'apparaît pas.

yg_be · Answer

alors je propose ceci: Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim valeurG As Date, valeurH As Date Dim cellH As Range Dim Réponse As Integer If Target.Count = 1 Then If Not Application.Intersect(Target, Range("G9:G" & Range("G" & Rows.Count).End(xlUp).Row)) Is Nothing Then 'j'annule l'application si ma cellule a déjà la formule + 12 mois par rapport à ma cellule de saisie d'intervention valeurG = Target.Value Set cellH = Target.Offset(0, 1) valeurH = cellH.Value If valeurH <> DateSerial(Year(valeurG) + 1, Month(valeurG), Day(valeurG)) Then Réponse = MsgBox("avez-vous changé le deshydrateur", vbYesNoCancel, "echeance deshy") If Réponse = vbYes Then ActiveSheet.Unprotect Password:="juju" cellH = DateSerial(Year(valeurG) + 2, Month(valeurG), Day(valeurG)) ActiveSheet.Protect Password:="juju", DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowFormattingRows:=True, AllowSorting:=True ElseIf Réponse = vbNo Then ActiveSheet.Unprotect Password:="juju" ActiveCell.Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent3 .TintAndShade = 0.399975585192419 .PatternTintAndShade = 0 End With ActiveSheet.Protect Password:="juju", DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowFormattingRows:=True, AllowSorting:=True End If ' Réponse End If ' valeurH <> DateSerial(Year(valeurG) + 1, Month(valeurG), Day(valeurG)) End If 'Not Application.Intersect(Target, Range("G9:G" & Range("G" & Rows.Count).End(xlUp).Row)) Is Nothing End If 'Target.Count = 1 End Sub

domimeca · Answer

Bonjour yg_be, Je viens d'essayer ton code, mais à force de travailler la dessus je commence à me mélanger les pinceaux. Le code de la feuille que je t'ai donné était un code d'essais. Pour "VbNo" je ne dois pas changer la couleur mais faire un copié coller valeur de la cellule "H" attenante. J'ai donc transposé (voir mon code ci dessous) mais le problème est que la formule de la cellule "H" réagi (+ 24 mois) avant que je fasse mon copié coller valeur. J'ai mis l'apostrophe devant ma modif. Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim valeurG As Date, valeurH As Date Dim cellH As Range Dim Réponse As Integer If Target.Count = 1 Then If Not Application.Intersect(Target, Range("G9:G" & Range("G" & Rows.Count).End(xlUp).Row)) Is Nothing Then 'j'annule l'application si ma cellule a déjà la formule + 12 mois par rapport à ma cellule de saisie d'intervention valeurG = Target.Value Set cellH = Target.Offset(0, 1) valeurH = cellH.Value If valeurH <> DateSerial(Year(valeurG) + 1, Month(valeurG), Day(valeurG)) Then Réponse = MsgBox("avez-vous changé le deshydrateur", vbYesNoCancel, "echeance deshy") If Réponse = vbYes Then ActiveSheet.Unprotect Password:="juju" cellH = DateSerial(Year(valeurG) + 2, Month(valeurG), Day(valeurG)) ActiveSheet.Protect Password:="juju", DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowFormattingRows:=True, AllowSorting:=True ElseIf Réponse = vbNo Then ActiveSheet.Unprotect Password:="juju" 'cellH.Select 'Selection.Copy 'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ActiveSheet.Protect Password:="juju", DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowFormattingRows:=True, AllowSorting:=True End If ' Réponse End If ' valeurH <> DateSerial(Year(valeurG) + 1, Month(valeurG), Day(valeurG)) End If 'Not Application.Intersect(Target, Range("G9:G" & Range("G" & Rows.Count).End(xlUp).Row)) Is Nothing End If 'Target.Count = 1 End Sub L'idée était de figer la date de la cellule "H" lorsqu'on clique NON Merci encore pour cette patience.

domimeca · Answer

Génial, exactement ce que je cherchais à faire. Je me doutais que Excel pouvait le faire, mais je n'arrivais pas à le lui demander correctement. 
      Pour répondre à ta question à propos de la MsgBox. En fait ce code sera sur la feuille générique qui permet de créer de nouveau client. Pour chaque client j'aurais la liste de ses véhicules et je saurais ce qu'il me restera à faire pour la prochaine visite. Feuille que je peux lui imprimer en PDF pour qu'il me bloc les véhicules lorsque je viendrais à son dépôt. Sur la première feuille de mon classeur, j'ai par liaison tous les véhicules de tous les clients et toutes les échéances. Quand je vais commencer ma campagne de révision de clim, en général en avril, je saurais d'un coup d’œil (mise en forme conditionnelles)  tous les déshydrateurs que je dois commander (il y a une date de péremption). Une commande groupée permet des négociations. 
      Un grand merci à toi, ainsi qu'a f894009.
        Je vais donc vite finaliser mon installation en supprimant mes formules inadéquates de ma colonnes H et reviendrais avec plaisir à la recherche du bouton "résolu" 

Bon Week-end et bonnes fêtes de fin d'année.

Private Sub Worksheet_SelectionChange sous conditions

21 réponses

Votre réponse

Discussions similaires

Newsletters