Poser une question lors de la désélection de la cellule active

Fermé
Berorn Messages postés 30 Date d'inscription jeudi 16 février 2017 Statut Membre Dernière intervention 5 août 2022 - 5 août 2021 à 11:37
f894009 Messages postés 17240 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 18 février 2025 - 7 août 2021 à 07:02
Bonjour le forum,

Je cherche à améliorer un morceau de code que j'ai fais. Il est loin d'être optimum mais j'ai pas trouvé d'autre solution...
Dans une feuille excel appelé "GANTT", j'ai un planificateur de projet où l'on inscrit une date de début et de fin des différentes tâches.
Je voudrais que lorsqu'on tape une date, on vérifie si celle-ci n'est pas un dimanche ou un samedi. Si c'est le cas je propose de corriger par vendredi ou lundi.
Mon code ci joint fonctionne mais fermé les yeux il fait peur, et ça sans vous parlez de la lenteur.
Mon premier problème est de savoir les "coordonnées" de la cellule avant de l'avoir quitté, car lorsqu'on écrit dans une cellule ensuite soit on tape sur entrer soit on clic sur une autre cellule donc on perd la position. Donc j'ai bricolait un truc en écrivant dans les cellules... Très BOF
Ensuite j'analyse si c'est un samedi, si c'est un dimanche et en fonction des réponses des msgbox , je recalcule la date.
Avez-vous d'autre idée ?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'Garde mémoire ancienne cellule active
If Sheets("GANTT").Cells(4, 6) <> "x" Then
Sheets("GANTT").Cells(3, 6) = ActiveCell.Row
Sheets("GANTT").Cells(3, 7) = ActiveCell.Column
Sheets("GANTT").Cells(4, 6) = "x"
Sheets("GANTT").Cells(4, 8) = ""

Else
Sheets("GANTT").Cells(3, 8) = ActiveCell.Row
Sheets("GANTT").Cells(3, 9) = ActiveCell.Column
Sheets("GANTT").Cells(4, 8) = "x"
Sheets("GANTT").Cells(4, 6) = ""

End If

'Lecture des coordonnées
If Sheets("GANTT").Cells(4, 6) = "x" Then
NumCol = Sheets("GANTT").Cells(3, 9)
NumLig = Sheets("GANTT").Cells(3, 8)
Else
NumCol = Sheets("GANTT").Cells(3, 7)
NumLig = Sheets("GANTT").Cells(3, 6)
End If

'Analyse si samedi ou dimanche + proposition de correction
If NumCol = 5 Or NumCol = 6 Then
If Sheets("GANTT").Cells(NumLig, NumCol) <> "" Then
If Weekday(Sheets("GANTT").Cells(NumLig, NumCol), vbMonday) = 6 Then
If MsgBox("Ce jour est un samedi, mettre au vendredi ?", vbYesNo) = vbYes Then
Sheets("GANTT").Cells(NumLig, NumCol) = Sheets("GANTT").Cells(NumLig, NumCol) - 1
Else
If MsgBox("Au lundi ?", vbYesNo) = vbYes Then
Sheets("GANTT").Cells(NumLig, NumCol) = Sheets("GANTT").Cells(NumLig, NumCol) + 2
End If
End If
Else
If Weekday(Sheets("GANTT").Cells(NumLig, NumCol), vbMonday) = 7 Then
If MsgBox("Ce jour est un dimanche, mettre au vendredi ?", vbYesNo) = vbYes Then
Sheets("GANTT").Cells(NumLig, NumCol) = Sheets("GANTT").Cells(NumLig, NumCol) - 2
Else
If MsgBox("Au lundi ?", vbYesNo) = vbYes Then
Sheets("GANTT").Cells(NumLig, NumCol) = Sheets("GANTT").Cells(NumLig, NumCol) + 1
End If
End If
End If
End If
End If
End If

End Sub

1 réponse

f894009 Messages postés 17240 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 18 février 2025 1 713
7 août 2021 à 07:02
Bonjour,
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Pas une bonne idee, pour moi, car a chaque changement de n'importe quelle cellule execution du code

Pouvez mettre un fichier exemple a dispo?
Que se passera-t-il si la personne n'entre pas un format date?
Qui met le x?
Le controle date peut se faire a la saisie (date, jour et debut inferieur a fin, pas avant 2021 mois y compris et peut-etre pas 2120)
Des que le x est ok, alors ecrire vos choses

Pour transmettre un fichier,
Veillez a ce qu'il n'y ait PAS DE DONNEES CONFIDENTIELLES
il faut passer par un site de pièce jointe tel que cjoint.com

Allez sur ce site : https://www.cjoint.com/
Clic sur parcourir,
Cherche ton fichier,
clic sur ouvrir,
Clic sur "Créer le lien cjoint",
Copier le lien,
Revenir ici le coller dans une réponse...

ou
'mon partage
https://mon-partage.fr/
0