DTpicker et changement sur label impossible

jopont · 23 Octobre 2008

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

jopont · 23 Octobre 2008

Re : DTpicker et changement sur label impossible

pourquoi lorsque je change la date dans dtpicker les valeurs des labels ne changent pas.
Ni le Fr_picker1.caption

kjin · 23 Octobre 2008

Re : DTpicker et changement sur label impossible

Bonsoir,

jopont à dit:
Code:

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

Parce qu' à priori, à part d'activer la feuille X, il ne se passe pas grand chose d'autre
tu dois déplacer les lignes concernées par le chgt de date dans cette partie de la procédure
A+
kjin

jopont · 24 Octobre 2008

Re : DTpicker et changement sur label impossible

c'est à dire.
merci

jopont · 24 Octobre 2008

Re : DTpicker et changement sur label impossible

je dois déplacé toutes les lignes du code avec les variables ?

merci

jopont · 24 Octobre 2008

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

kjin · 24 Octobre 2008

Re : DTpicker et changement sur label impossible

Bonjour,

jopont à dit:
je dois déplacé toutes les lignes du code avec les variables ?
merci

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

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...

jopont · 24 Octobre 2008

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

jopont · 24 Octobre 2008

Re : DTpicker et changement sur label impossible

personne pour m'aider ?

ChTi160 · 24 Octobre 2008

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

ChTi160 · 24 Octobre 2008

Re : DTpicker et changement sur label impossible

Re
Un exemple
Le fichier : Regarde la pièce jointe ExempleV1.zip

Bonne fin de journée

kjin · 25 Octobre 2008

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

jopont · 26 Octobre 2008

Re : DTpicker et changement sur label impossible

ok c'est ce que je voulais mais le jour férié doit être renvoyé même si on est en période été.

comment faire merci

ChTi160 · 27 Octobre 2008

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

DTpicker et changement sur label impossible

jopont

XLDnaute Impliqué

jopont

XLDnaute Impliqué

kjin

XLDnaute Barbatruc

jopont

XLDnaute Impliqué

jopont

XLDnaute Impliqué

jopont

XLDnaute Impliqué

kjin

XLDnaute Barbatruc

jopont

XLDnaute Impliqué

jopont

XLDnaute Impliqué

ChTi160

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

Pièces jointes

kjin

XLDnaute Barbatruc

Pièces jointes

jopont

XLDnaute Impliqué

ChTi160

XLDnaute Barbatruc

Discussions similaires

DTpicker et changement sur label impossible

XLDnaute Impliqué

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Impliqué

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency