DTpicker et changement sur label impossible

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion jopont
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
J

jopont

XLDnaute Impliqué
Bonsoir,

Dans le code ci-dessous j'ai intégrer DTpicker à un userform.

Suivant la date choisi avec DTpicker, des label inscrivent des données.

Seulement cela ne fonctionne que sur un changement dans Dtpicker.
Après si je change de date les label n'affiche pas les nouvelles données


Private Sub BTN_fermer_Click()
Unload Me
End Sub

Private Sub DTPicker1_change()
Sheets(MonthName(Month(DTPicker1))).Activate

End Sub
Private Sub UserForm_Initialize()
Dim Colo As Long
Dim date1 As String
Dim data1 As String
Dim jour As Integer
Dim date2 As Date
Dim date3 As Date
Dim date4 As Date
Dim trouve As Boolean
Dim cellule As Range
Dim nomfeuille1 As String
Dim col1 As String
Dim lidep1 As Long
Dim Lifin As Long


With Sheets(MonthName(Month(DTPicker1)))
Colo = Day(DTPicker1) * 2 + 1

date1 = Format(Now, "dddd d mmm yyyy")
jour = Weekday(DTPicker1)

FR_picker1.Caption = "vous avez selectionné le , " & Format(DTPicker1, "dddd d mmm yyyy") & " , les effectifs sont : "
EOGjour.Caption = "EOG SPP Jour : " & .Cells(77, Colo).Value - 1
EOGnuit.Caption = "EOG SPP Nuit : " & .Cells(77, Colo + 1).Value - 1
FR_picker2.Caption = "effectif semaine"
normal1.Caption = " 13 SPP de Jour"
normal2.Caption = " 11 SPP de Nuit"
If Cells(77, Colo).Value < 13 Or Cells(77, Colo + 1) < 11 Then
IMG_attention2.Picture = LoadPicture(ThisWorkbook.Path & "\attention.jpg")
lbl1.Caption = "Demain, nous sommes en effectif semaine "
lbl2.Caption = "L'effectif de jour doit être de ( chef de garde compris) : " & 13
lbl3.Caption = "L'effectif de nuit doit être de ( chef de garde compris) : " & 11
End If
End With
End Sub
 
Trier par date Trier par votes
Re : DTpicker et changement sur label impossible

dans le code ci-dessous , j'ai un probleme de débogage au niveau de la ligne for each cellule


Private Sub DTPicker1_change()
Dim Colo As Long
Dim date11 As String
Dim data1 As String
Dim journ As Integer
Dim date2 As Date
Dim debvac As Date
Dim finvac As Date
Dim trouver As Boolean
Dim cellule As Range
Dim nomfeuille2 As String
Dim col11 As String
Dim lidep11 As Long
Dim Lifin1 As Long

Sheets(MonthName(Month(DTPicker1))).Activate
With Sheets(MonthName(Month(DTPicker1)))
Colo = Day(DTPicker1) * 2 + 1

date11 = Format(Now, "dddd d mmm yyyy")
journ = Weekday(DTPicker1)

FR_picker1.Caption = "vous avez selectionné le , " & Format(DTPicker1, "dddd d mmm yyyy") & " , les effectifs sont : "
EOGjour.Caption = "EOG SPP Jour : " & .Cells(77, Colo).Value - 1 & " SPP"
EOGnuit.Caption = "EOG SPP Nuit : " & .Cells(77, Colo + 1).Value - 1 & " SPP"
FR_picker2.Caption = "effectif semaine"
normal1.Caption = " 13 SPP de Jour"
normal2.Caption = " 11 SPP de Nuit"
lbl1.Caption = "nous sommes en effectif semaine "
lbl2.Caption = "L'effectif de jour doit être de ( chef de garde compris) : " & 13 & " SPP"
lbl3.Caption = "L'effectif de nuit doit être de ( chef de garde compris) : " & 11 & " SPP "
If Cells(77, Colo).Value < 13 Or Cells(77, Colo + 1) < 11 Then
IMG_attention2.Picture = LoadPicture(ThisWorkbook.Path & "\attention.jpg")
End If

If journ = 7 Or journ = 1 Then ' dimanche ou samedi
trouver = True
If jour = 1 Then Label1.Caption = "nous somme en effectif dimanche "
FR_picker2.Caption = " effectif dimanche "
If jour = 7 Then Label1.Caption = "nous sommes en effectif samedi "
FR_picker2.Caption = " effectif samedi "
normal1.Caption = " 11 SPP de Jour"
normal2.Caption = " 09 SPP de Nuit"
If Cells(77, Colonne).Value < 11 Or Cells(77, Colonne + 1) < 9 Then
IMG_Attention.Picture = LoadPicture(ThisWorkbook.Path & "\attention.jpg")
Label2.Caption = "L'effectif de jour doit être de ( chef de garde compris) : " & 11 & " SPP"
Label3.Caption = "L'effectif de nuit doit être de ( chef de garde compris) : " & 9 & " SPP "


End If
End If
debvac = "28/06/2009"
finvac = "28/08/2009"

If DTPicker > debvac And DTPicker < finvac And trouver = False Then
Label1.Caption = "nous sommes en effectif été"
FR_picker2.Caption = " effectif été "
normal1.Caption = " 12 SPP de Jour"
normal2.Caption = " 10 SPP de Nuit"
If Cells(77, Colonne).Value < 12 Or Cells(77, Colonne + 1) < 10 Then
IMG_attention2.Picture = LoadPicture(ThisWorkbook.Path & "\attention.jpg")
Label5.Caption = "L'effectif de jour doit être de ( chef de garde compris) : " & 12 & " SPP"
Label6.Caption = "L'effectif de nuit doit être de ( chef de garde compris) : " & 10 & " SPP "
trouver = True
End If
End If
End With
If trouver = False Then ' recherche si jour férié
'**********************************
nomfeuille2 = "paramètres"
col11 = "W"
lidep1 = 2
Lifin = 14
'************************************
With Sheets(nomfeuille2)
For Each cellule In .Range(col11 & lidep11 & ":" & col11 & Lifin1)
If IsDate(cellule.Value) And cellule.Value = DTPicker Then
Label1.Caption = "nous sommes en effectif Jour Férié"
FR_picker2.Caption = " Effectif jour férié "
normal1.Caption = " 11 SPP de Jour"
normal2.Caption = " 9 SPP de Nuit"
If Cells(77, Colonne).Value < 11 Or Cells(77, Colonne + 1) < 9 Then
IMG_attention2.Picture = LoadPicture(ThisWorkbook.Path & "\attention.jpg")
Label5.Caption = "L'effectif de jour doit être de ( chef de garde compris) : " & 11 & " SPP"
Label6.Caption = "L'effectif de nuit doit être de ( chef de garde compris) : " & 11 & " SPP "


End If
End If
Next cellule
End With
End If
End Sub
 
Vote positif 0 Vote négatif
Re : DTpicker et changement sur label impossible

Bonjour,
jopont à dit:
je dois déplacé toutes les lignes du code avec les variables ?
merci
Cliquez pour agrandir...
Je n'ai pas dis ça ...

jopont à dit:
Code: 
Private Sub UserForm_Initialize()
...
With Sheets(MonthName(Month(DTPicker1)))
Colo = Day(DTPicker1) * 2 + 1
date1 = Format(Now, "dddd d mmm yyyy")
jour = Weekday(DTPicker1)
FR_picker1.Caption = "vous avez selectionné le , " & Format(DTPicker1, "dddd
...
End Sub
Cliquez pour agrandir...
Les labels (si c' est bien de ceux ci dont tu parles) sont mis à jour à l'initialisation du formulaire mais il sont également concernés par l'événement "Change" du DTP, alors qu'aucune ligne de ton code n'y fait référence
Le fait d'activer la feuille X, n'y changera rien
Les variables peuvent être déclarées pour l'ensemble du module si c'est nécessaire, mais sans le code complet ni infos précises...
A+
kjin
Edit : je viens de voir ton nouveau message et comme ma boule de cristal refuse obstinément aujourd'hui..., le mieux est de faire passer un extrait de ton fichier avec le formulaire...
 
Dernière édition:
Vote positif 0 Vote négatif
Re : DTpicker et changement sur label impossible

Dans le code ci-dessous les EOG.caption se récupère bien en feonction de la date choisie dans dtpicker.

Par contre la partie du code chargé de voir si il s'agit d'un samedi ou dimanche ou jour férié ou jour d'une plage de date données ne fonctionne pas ou presque.
qu'est ce qui ne va pas dans mon code
merci
Private Sub DTPicker1_change()
Dim Colo As Long
Dim date11 As String
Dim data1 As String
Dim journ As Integer
Dim date2 As Date
Dim debvac As Date
Dim finvac As Date
Dim trouver As Boolean
Dim cellules As Range
Dim nomfeuille2 As String
Dim col11 As String
Dim lidep11 As Long
Dim Lifin1 As Long

Sheets(MonthName(Month(DTPicker1))).Activate
With Sheets(MonthName(Month(DTPicker1)))
Colo = Day(DTPicker1) * 2 + 1

date11 = Format(Now, "dddd d mmm yyyy")
journ = Weekday(DTPicker1)

FR_picker1.Caption = "vous avez selectionné le , " & Format(DTPicker1, "dddd d mmm yyyy") & " , les effectifs sont : "
EOGjour.Caption = "EOG SPP Jour : " & .Cells(77, Colo).Value - 1 & " SPP"
EOGnuit.Caption = "EOG SPP Nuit : " & .Cells(77, Colo + 1).Value - 1 & " SPP"
FR_picker2.Caption = "effectif semaine"
normal1.Caption = " 13 SPP de Jour"
normal2.Caption = " 11 SPP de Nuit"
lbl1.Caption = "nous sommes en effectif semaine "
lbl2.Caption = "L'effectif de jour doit être de ( chef de garde compris) : " & 13 & " SPP"
lbl3.Caption = "L'effectif de nuit doit être de ( chef de garde compris) : " & 11 & " SPP "
If Cells(77, Colo).Value < 13 Or Cells(77, Colo + 1) < 11 Then
IMG_attention2.Picture = LoadPicture(ThisWorkbook.Path & "\attention.jpg")
End If

If journ = 7 Or journ = 1 Then ' dimanche ou samedi
trouver = True
If journ = 1 Then lbl1.Caption = "nous somme en effectif dimanche "
FR_picker2.Caption = " effectif dimanche "
If jour = 7 Then lbl1.Caption = "nous sommes en effectif samedi "
FR_picker2.Caption = " effectif samedi "
normal1.Caption = " 11 SPP de Jour"
normal2.Caption = " 09 SPP de Nuit"
lbl2.Caption = "L'effectif de jour doit être de ( chef de garde compris) : " & 11 & " SPP"
lbl3.Caption = "L'effectif de nuit doit être de ( chef de garde compris) : " & 9 & " SPP "
If Cells(77, Colonne + 2).Value < 11 Or Cells(77, Colonne + 3) < 9 Then
IMG_attention2.Picture = LoadPicture(ThisWorkbook.Path & "\attention.jpg")


End If

debvac = "28/06/2009"
finvac = "28/08/2009"

If DTPicker > debvac And DTPicker < finvac And trouver = False Then
lbl1.Caption = "nous sommes en effectif été"
FR_picker2.Caption = " effectif été "
normal1.Caption = " 12 SPP de Jour"
normal2.Caption = " 10 SPP de Nuit"
If Cells(77, Colonne).Value < 12 Or Cells(77, Colonne + 1) < 10 Then
IMG_attention2.Picture = LoadPicture(ThisWorkbook.Path & "\attention.jpg")
lbl2.Caption = "L'effectif de jour doit être de ( chef de garde compris) : " & 12 & " SPP"
lbl3.Caption = "L'effectif de nuit doit être de ( chef de garde compris) : " & 10 & " SPP "
trouver = True
End If
End With

If trouver = False Then ' recherche si jour férié
'**********************************
nomfeuille2 = "paramètres"
col11 = "W"
lidep11 = 2
Lifin11 = 14
data1 = DTPicker
'************************************
With Sheets(nomfeuille2)
For Each cellules In .Range(col11 & lidep11 & ":" & col11 & Lifin11)
If IsDate(cellules.Value) And cellules.Value = data1 Then
lbl1.Caption = "nous sommes en effectif Jour Férié"
If Cells(77, Colonne).Value < 11 Or Cells(77, Colonne + 1) < 9 Then
IMG_attention2.Picture = LoadPicture(ThisWorkbook.Path & "\attention.jpg")
lbl2.Caption = "L'effectif de jour doit être de ( chef de garde compris) : " & 11 & " SPP"
lbl3.Caption = "L'effectif de nuit doit être de ( chef de garde compris) : " & 11 & " SPP "
FR_picker2.Caption = " Effectif jour férié "
normal1.Caption = " 11 SPP de Jour"
normal2.Caption = " 9 SPP de Nuit"
End If

Next cellules
End With
End If
End Sub



Private Sub UserForm_Initialize()

DTPicker1.Value = Now
End Sub
 
Vote positif 0 Vote négatif
Re : DTpicker et changement sur label impossible

Salut jopont
Bonjour le fil
Comme on te l'a déjà suggéré ,il faudrait mettre un fichier car il n'est pas évident de tester (il faut que l'on recrée l'ensemble des éléments)
dans l'attente
Bonne fin de journée
 
Vote positif 0 Vote négatif
Re : DTpicker et changement sur label impossible

Bonjour,
Suite à ton MP, il suffit de faire passer un extrait du fichier avec le formulaire et une feuille exemple dépourvue de toutes les données inutiles pour les tests ou confidentielles
Puisque jusque là, tu ne l'as pas fait, j'ai recréé un formulaire basé sur le code fourni précédemment, en désactivant les images, et ne sachant pas quelles sont les infos à vérifier dans la feuille mensuelle puique je ne l'ai pas ; néanmoins, il me semble que c'est une bonne base
L'explication est dans la feuille paramètres
Sache bien que je n'en ferais pas plus si tu ne fournis pas un effort
En outre, le fichier joint fait 24 ko compressé et on peut encore améliorer en supprimant les mises en forme !
A+
kjin
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : DTpicker et changement sur label impossible

Salut
Bonsoir le fil
Bonsoir le Forum

voila la macro modifiée pour qu'un jour de vacances , qui est férié , soit retenu comme Férié
Code: 
Sub MAJ()

Dim Colo As Long
Dim NumJour As Integer
Dim DebVac As Date
Dim FinVac As Date
Dim DateF As Date
Dim Férié As Range

With Sheets(MonthName(Month(DTPicker1)))
Colo = Day(DTPicker1) * 2 + 1
NumJour = Weekday(DTPicker1)
DebVac = "10/10/2008"
FinVac = "19/10/2008"
DateF = Format(DTPicker1, "dd/mm/yyyy")

           Set Férié = Sheets("Paramètres").Range("A1:A10").Find(DateF)
   If Not Férié Is Nothing Then
            Lbl1.Caption = "nous sommes en effectif Jour Férié"
            FR_picker2.Caption = " Effectif jour férié "
            Normal1.Caption = " 11 SPP de Jour"
            Normal2.Caption = " 9 SPP de Nuit"
            Lbl2.Caption = "L'effectif de jour doit être de ( chef de garde compris) : " & 11 & " SPP"
            Lbl3.Caption = "L'effectif de nuit doit être de ( chef de garde compris) : " & 11 & " SPP "
            'If Cells(77, Colonne).Value < 11 Or Cells(77, Colonne + 1) < 9 Then
            'IMG_attention2.Picture = LoadPicture(ThisWorkbook.Path & "\attention.jpg")
            'End if

        Else
            If NumJour = 7 Or NumJour = 1 Then ' dimanche ou samedi
                If NumJour = 1 Then
                Lbl1.Caption = "nous somme en effectif dimanche "
                FR_picker2.Caption = " effectif dimanche "
                End If
                If NumJour = 7 Then
                Lbl1.Caption = "nous sommes en effectif samedi "
                FR_picker2.Caption = " effectif samedi "
                End If
                Normal1.Caption = " 11 SPP de Jour"
                Normal2.Caption = " 09 SPP de Nuit"
                Lbl2.Caption = "L'effectif de jour doit être de ( chef de garde compris) : " & 11 & " SPP"
                Lbl3.Caption = "L'effectif de nuit doit être de ( chef de garde compris) : " & 9 & " SPP "
                'If Cells(77, Colonne + 2).Value < 11 Or Cells(77, Colonne + 3) < 9 Then
                'IMG_attention2.Picture = LoadPicture(ThisWorkbook.Path & "\attention.jpg")
                'End If
            Else
    
                FR_picker2.Caption = "effectif semaine"
                Normal1.Caption = " 13 SPP de Jour"
                Normal2.Caption = " 11 SPP de Nuit"
                Lbl1.Caption = "nous sommes en effectif semaine "
                Lbl2.Caption = "L'effectif de jour doit être de ( chef de garde compris) : " & 13 & " SPP"
                Lbl3.Caption = "L'effectif de nuit doit être de ( chef de garde compris) : " & 11 & " SPP "
                'If Cells(77, Colo).Value < 13 Or Cells(77, Colo + 1) < 11 Then
                'IMG_attention2.Picture = LoadPicture(ThisWorkbook.Path & "\attention.jpg")
                'End if
             End If
            If DTPicker1 > DebVac And DTPicker1 < FinVac Then
                Lbl1.Caption = "nous sommes en effectif été"
                FR_picker2.Caption = " effectif été "
                Normal1.Caption = " 12 SPP de Jour"
                Normal2.Caption = " 10 SPP de Nuit"
                Lbl2.Caption = "L'effectif de jour doit être de ( chef de garde compris) : " & 12 & " SPP"
                Lbl3.Caption = "L'effectif de nuit doit être de ( chef de garde compris) : " & 10 & " SPP "
                'If Cells(77, Colonne).Value < 12 Or Cells(77, Colonne + 1) < 10 Then
                'IMG_attention2.Picture = LoadPicture(ThisWorkbook.Path & "\attention.jpg")
                'End If
             End If
            End If
        
    
    
FR_picker1.Caption = "vous avez selectionné le , " & Format(DTPicker1, "dddd d mmm yyyy") & " , les effectifs sont : "
'EOGjour.Caption = "EOG SPP Jour : " & .Cells(77, Colo).Value - 1 & " SPP"
'EOGnuit.Caption = "EOG SPP Nuit : " & .Cells(77, Colo + 1).Value - 1 & " SPP"

End With
Set Férié = Nothing
End Sub
il suffisait de déplacer le test EST Férié après celui de EST vacances

en espérant avoir compris lol
Bonne fin de Soirée
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

patricktoulon
  • Question Question
Microsoft 365 datepicker dynamique intra userform ou dans feuille 2 versions(frame dynamique)(toute version d'excel )
6 7 8
Réponses
105
Affichages
3 K
Usine à gaz
Usine à gaz
A
  • Question Question
XL 2019 Copie d'une valeur dans la cellule à côté d'une valeur trouvé
Réponses
1
Affichages
449
sylvanu
sylvanu
U
  • Question Question
Autres [RÉSOLU] Compléter la macro mais comment et où?
Réponses
2
Affichages
568
un internaute
U
F
  • Question Question
Microsoft 365 Problème mémoire insuffisante
Réponses
5
Affichages
702
TooFatBoy
TooFatBoy
AIXELS
  • Question Question
Microsoft 365 Afficher récap mois en cours dans un Label
Réponses
12
Affichages
584
AIXELS
AIXELS
piga25
  • Résolu(e)
XL 2016 Erreur dans code VBA
4 5 6
Réponses
76
Affichages
3 K
patricktoulon
patricktoulon
G
  • Résolu(e)
XL 2016 Pb de tri et sous totaux
2
Réponses
27
Affichages
1 K
Gestionnaire_rh
G
badraaliou4
  • Question Question
XL 2021 Importer les données Access dans Excel
Réponses
2
Affichages
494
badraaliou4
badraaliou4
K
  • Résolu(e)
XL 2016 Affichage TextBox
Réponses
6
Affichages
623
KRUG WOO
K
C
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
370
CDALE
C
J
  • Question Question
Microsoft 365 macro qui ouvre des fichiers excel de type "analyze in excel" généré par power bi et met à jour un filtre "mois" sur plusieurs tcd
Réponses
0
Affichages
562
JJ69
J
U
  • Question Question
Autres incorporer une macro dans une autre macro
Réponses
5
Affichages
668
Phil69970
Phil69970
N
  • Résolu(e)
Microsoft 365 Rechercher la dernière cellule saisie dans un TS et ajouter l'heure système
18 19 20
Réponses
297
Affichages
70 K
NONO14
N
C
  • Résolu(e)
XL 2016 VBA : inversion de Date sur Range.Resize ... = Tableau après Transpose du Tableau
Réponses
2
Affichages
290
crocrocro
C
JBARBE
  • Question Question
Autres problème avec les dates
2
Réponses
19
Affichages
1 K
TooFatBoy
TooFatBoy
M
  • Question Question
Microsoft 365 Erreur sur mon Code VBA
Réponses
2
Affichages
667
Gégé-45550
Gégé-45550
yojema
  • Question Question
XL 2021 faire évoluer un code VBA
Réponses
3
Affichages
578
Dranreb
Dranreb
L
  • Question Question
VBA : erreur sur boucle
Réponses
2
Affichages
435
Latias
L
O
  • Question Question
XL 2019 Je veux afficher mes données dans ma Listbox1 avec l'entete de ma Base donnée et fait la recherche sans que cela derange l'entete.
Réponses
6
Affichages
940
ChTi160
ChTi160
Lu76Fer
Conversion entre Date Universelle GMT et Date Localisée, puis correction de date extraite du DOS
Réponses
0
Affichages
410
Lu76Fer
Lu76Fer
Retour