VBA : 1ere et dernière date du mois (ouvrés) [RESOLU]

I

Imer2007

XLDnaute Occasionnel
Bonjour à tous,

Je sèche actuellement sur un truc.
Dans un classeur, j'ai une colonne dans laquelle j'ai inscrit tous les jours de l'année 2012 (uniquement les jours ouvrés donc sans les samedi/dimanche et jours fériés).

Je viens de créer un userform dans lequel une combobox (liste déroulante qui s'appelle select_jour) récupère tous ces jours (via rowsource).

Je souhaiterais pouvoir activer deux cases à cocher sur ce userform :
1- première case à cocher si la date sélectionnée est le 1er jour ouvré du mois
2- deuxième case à cocher si la date sélectionnée correspond au dernier lundi du mois.

J'ai besoin de vos lumières parce que là, je sèche totalement !

J'ai déjà une partie plus 'facile', ou des sauvegardes sont actives le lundi et le jeudi :

Code: 
Private Sub select_jour_Change()
' conversion pour afficher sous la forme jour date mois année, ex : lundi 2 janvier 2012
select_jour.Value = Format(select_jour.Value, "dddd d mmmm yyyy")

' splitte la variable pour n'avoir que le jour, ex : lundi
decoupe = Split(select_jour.Value, " ")
' récupération du nom du jour
jour = decoupe(0)
If jour = "lundi" Then
' sauvegardes activées le lundi
    coche_sauvegarde_hebdo.Enabled = True
    coche_sauvegarde_mensuelle.Enabled = True
    coche_rniam.Enabled = True
Else
    coche_sauvegarde_hebdo.Enabled = False
    coche_sauvegarde_mensuelle.Enabled = False
    coche_rniam.Enabled = False
End If
If jour = "jeudi" Then
' sauvegarde intranet active le jeudi uniquement
    coche_intranet.Enabled = True
Else
    coche_intranet.Enabled = False
End If
End Sub
 
Dernière édition:
Trier par date Trier par votes
JNP

JNP

XLDnaute Barbatruc
Re : VBA : 1ere et dernière date du mois (ouvrés)

Bonjour Imer2007 :),
D'abord, j'éviterais de modifier la valeur d'un combo en RowSource :rolleyes:... alors qu'il te suffit pour ton test d'écrire
Code: 
decoupe = Format(select_jour.Value, "dddd")
Après, sans ton fichier en test, difficile de donner une réponse :p...
Bon courage :cool:
 
Vote positif 0 Vote négatif
I

Imer2007

XLDnaute Occasionnel
Re : VBA : 1ere et dernière date du mois (ouvrés)

Bonjour JNP,

Voici le fichier dépatouillé du maximum de données.

Si besoin de plus d'explication, n'hésitez pas à me demander.
 

Pièces jointes

  • travaux.xls
    42 KB · Affichages: 129
  • travaux.xls
    42 KB · Affichages: 138
  • travaux.xls
    42 KB · Affichages: 138
Vote positif 0 Vote négatif
I

Imer2007

XLDnaute Occasionnel
Re : VBA : 1ere et dernière date du mois (ouvrés)

Bon j'ai fais au plus simple (il y a surement mieux niveau prog mais là ca a le mérite de bien fonctionner)

Code: 
' splitte la variable pour n'avoir que le jour
decoupe = Split(select_jour.Value, " ")
' récupération du nom du jour
jour = decoupe(0)
journum = decoupe(1)

If journum = 1 Or select_jour.Value = "lundi 2 janvier 2012" Or select_jour.Value = "mercredi 2 mai 2012" Or select_jour.Value = "vendredi 2 novembre 2012" Then
' active l'OMNIVISTA et le relevé d'imprimantes le 1er du mois
    coche_omnivista.Enabled = True
    coche_imprimantes.Enabled = True
Else
    coche_omnivista.Enabled = False
    coche_imprimantes.Enabled = False
End If
 
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
Re : VBA : 1ere et dernière date du mois (ouvrés)

Re :),
A adapter à ton cas exact
Code: 
Private Sub ComboBox1_Change()
Dim Cellule As Range
Dim Découpe, MaDate As Date
Découpe = Split(Me.ComboBox1.Text, " ")
MaDate = CDate(Découpe(1) & " " & Découpe(2) & " " & Découpe(3))
Set Cellule = Range("A1:A365").Find(MaDate, lookat:=xlWhole)
If Cellule.Row = 1 Then
MsgBox "1er jour du mois"
ElseIf Month(Cellule.Offset(-1, 0)) <> Month(MaDate) Then
MsgBox "1er jour du mois"
End If
End Sub

Private Sub UserForm_Initialize()
Dim I As Integer
For I = 1 To 261
Me.ComboBox1.AddItem Format(Range("A" & I), "dddd d mmmm yyyy")
Next I
End Sub
Bon courage :cool:
 
Vote positif 0 Vote négatif
KenDev

KenDev

XLDnaute Impliqué
Re : VBA : 1ere et dernière date du mois (ouvrés)

Bonjour Imer, JNP,

Une proposition pour 1er jour du mois et dernier lundi du mois (ce dernier valable jusqu'en 2099) .

Dans la Private Sub select_jour_Change()
VB: 
coche_omnivista = False
If select_jour.ListIndex <> 0 Then
    If Val(decoupe(1)) < Day(Worksheets("Calendrier").Cells(select_jour.ListIndex + 1, 1)) Then coche_omnivista = True
Else
    coche_omnivista = True
End If

Set rg = Worksheets("Calendrier").Cells(select_jour.ListIndex + 2, 1)
coche_sauvegarde_mensuelle = False
If WorksheetFunction.Weekday(rg) = 2 Then
    Select Case Month(rg)
        Case 1, 3, 5, 7, 8, 10, 12
            If Day(rg) > 24 Then coche_sauvegarde_mensuelle = True
        Case 4, 6, 9, 11
            If Day(rg) > 23 Then coche_sauvegarde_mensuelle = True
        Case 2
            If Year(rg) Mod 4 = 0 Then
                If Day(rg) > 22 Then coche_sauvegarde_mensuelle = True
            Else
                If Day(rg) > 21 Then coche_sauvegarde_mensuelle = True
            End If
    End Select
End If

Cordialement

KD
 
Vote positif 0 Vote négatif
I

Imer2007

XLDnaute Occasionnel
Re : VBA : 1ere et dernière date du mois (ouvrés)

Re,

Effectivement, j'ai fais les modifs du code de JPN en adaptant et ca fonctionne parfaitement.

KD, j'ai testé ton code et quelque soit le jour ca m'active la case "Relevé imprimantes" et ca me coche la case "Omnivista"... J'ai bouéré où ?:confused:
 
Vote positif 0 Vote négatif
KenDev

KenDev

XLDnaute Impliqué
Re : VBA : 1ere et dernière date du mois (ouvrés)

Re,

Ben je sais pas ! :) Je me suis contenté de coller ce code à la fin de la Private Sub select_jour_Change() sans rien toucher au reste et j'obtiens OMNIVISTA coché les 1ers jours du mois et sauvegarde coché les derniers lundis du mois. Tu as touché à autre chose par rapport au fichier fourni ? Cordialement

KD
 
Vote positif 0 Vote négatif
I

Imer2007

XLDnaute Occasionnel
Re : VBA : 1ere et dernière date du mois (ouvrés)

Ben non, j'ai même repris la base en me disant que j'avais peut etre planté quelque chose, mais même en rajoutant ton code, ca m'active les 2 cases à cocher tous les jours et ca me coche OMNIVISTA.

Bizarre...
 
Vote positif 0 Vote négatif
I

Imer2007

XLDnaute Occasionnel
Re : VBA : 1ere et dernière date du mois (ouvrés)

Ok j'ai pigé le truc :

effectivement ca marche, cependant ce que je souhaitais, c'était "d'activer" la case à cocher, et non de la "cocher".

Donc normalement, si je change les "coche_sauvegarde_mensuelle = True" en "coche_sauvegarde_mensuelle.enabled = True" etc., ca devrait le faire ! ;)

Je teste et te dit. :)
 
Vote positif 0 Vote négatif
I

Imer2007

XLDnaute Occasionnel
Re : VBA : 1ere et dernière date du mois (ouvrés)

Donc effectivement c'est ok ca fonctionne avec les "enabled".

Seul souci, c'est "qu'est ce qui correspond à quoi" ?

La partie "premier jour du mois" ?
La partie "dernier lundi du mois" ?

Parce qu'en suivant ton principe, ca m'active la case à cocher relevé_imprimante partout (alors qu'elle ne doit être active que le 1er jour du mois) ... bon ok, j'ai mis des "coche_imprimantes.Enabled = True" un peu partout lol...

Code: 
Private Sub select_jour_Change()
' conversion pour afficher sous la forme jour date mois année, ex : lundi 2 janvier 2012
select_jour.Value = Format(select_jour.Value, "dddd d mmmm yyyy")

' splitte la variable pour n'avoir que le jour
decoupe = Split(select_jour.Value, " ")
' récupération du nom du jour
jour = decoupe(0)
If jour = "lundi" Then
' RNIAM et sauvegardes activées le lundi
    coche_sauvegarde_hebdo.Enabled = True
    coche_sauvegarde_mensuelle.Enabled = True
    coche_rniam.Enabled = True
Else
    coche_sauvegarde_hebdo.Enabled = False
    coche_sauvegarde_mensuelle.Enabled = False
    coche_rniam.Enabled = False
End If

If jour = "jeudi" Then
' sauvegarde intranet active le jeudi uniquement
    coche_intranet.Enabled = True
Else
    coche_intranet.Enabled = False
End If

coche_omnivista.Enabled = False
coche_imprimantes.Enabled = False
If select_jour.ListIndex <> 0 Then
    If Val(decoupe(1)) < Day(Worksheets("Calendrier").Cells(select_jour.ListIndex + 1, 1)) Then
        coche_omnivista.Enabled = True
        coche_imprimantes.Enabled = True
    End If
Else
    coche_omnivista.Enabled = True
    coche_imprimantes.Enabled = True
End If

Set rg = Worksheets("Calendrier").Cells(select_jour.ListIndex + 2, 1)
coche_sauvegarde_mensuelle.Enabled = False
coche_imprimantes.Enabled = True
If WorksheetFunction.Weekday(rg) = 2 Then
    Select Case Month(rg)
        Case 1, 3, 5, 7, 8, 10, 12
            If Day(rg) > 24 Then
                coche_sauvegarde_mensuelle.Enabled = True
                coche_imprimantes.Enabled = True
            End If
        Case 4, 6, 9, 11
            If Day(rg) > 23 Then
                coche_sauvegarde_mensuelle.Enabled = True
                coche_imprimantes.Enabled = True
            End If
        Case 2
            If Year(rg) Mod 4 = 0 Then
                If Day(rg) > 22 Then
                    coche_sauvegarde_mensuelle.Enabled = True
                    coche_imprimantes.Enabled = True
                End If
            Else
                If Day(rg) > 21 Then
                    coche_sauvegarde_mensuelle.Enabled = True
                    coche_imprimantes.Enabled = True
                End If
            End If
    End Select
End If
End Sub
 
Vote positif 0 Vote négatif
KenDev

KenDev

XLDnaute Impliqué
Re : VBA : 1ere et dernière date du mois (ouvrés)

Imer2007 à dit:
Code: 
coche_omnivista.Enabled = False
coche_imprimantes.Enabled = False
If select_jour.ListIndex <> 0 Then
    If Val(decoupe(1)) < Day(Worksheets("Calendrier").Cells(select_jour.ListIndex + 1, 1)) Then
        coche_omnivista.Enabled = True
        coche_imprimantes.Enabled = True
    End If
Else
    coche_omnivista.Enabled = True
    coche_imprimantes.Enabled = True
End If

Set rg = Worksheets("Calendrier").Cells(select_jour.ListIndex + 2, 1)
coche_sauvegarde_mensuelle.Enabled = False
coche_imprimantes.Enabled = True
If WorksheetFunction.Weekday(rg) = 2 Then
    Select Case Month(rg)
        Case 1, 3, 5, 7, 8, 10, 12
            If Day(rg) > 24 Then
                coche_sauvegarde_mensuelle.Enabled = True
                coche_imprimantes.Enabled = True
            End If
        Case 4, 6, 9, 11
            If Day(rg) > 23 Then
                coche_sauvegarde_mensuelle.Enabled = True
                coche_imprimantes.Enabled = True
            End If
        Case 2
            If Year(rg) Mod 4 = 0 Then
                If Day(rg) > 22 Then
                    coche_sauvegarde_mensuelle.Enabled = True
                    coche_imprimantes.Enabled = True
                End If
            Else
                If Day(rg) > 21 Then
                    coche_sauvegarde_mensuelle.Enabled = True
                    coche_imprimantes.Enabled = True
                End If
            End If
    End Select
End If
Cliquez pour agrandir...

Sans avoir testé ce code que font les 'coche_imprimantes.Enabled' dans la partie dernier lundi du mois ? :)

Partie 1er jour du mois : (semble ok)
Explication : si le jour précédent le jour sélectionné est supérieur à celui ci c'est qu'on est en début de mois.
VB: 
[code]
coche_omnivista.Enabled = False
coche_imprimantes.Enabled = False
If select_jour.ListIndex <> 0 Then
    If Val(decoupe(1)) < Day(Worksheets("Calendrier").Cells(select_jour.ListIndex + 1, 1)) Then
        coche_omnivista.Enabled = True
        coche_imprimantes.Enabled = True
    End If
Else
    coche_omnivista.Enabled = True
    coche_imprimantes.Enabled = True
End If

Partie dernier lundi du mois (nettoyage):
Explication : On détermine le jour séletionné, si c'est un lundi on détermine le mois et selon le nombre de jours de ce dernier on passe le test correspondant :
VB: 
Set rg = Worksheets("Calendrier").Cells(select_jour.ListIndex + 2, 1)
coche_sauvegarde_mensuelle.Enabled = False
If WorksheetFunction.Weekday(rg) = 2 Then
    Select Case Month(rg)
        Case 1, 3, 5, 7, 8, 10, 12
            If Day(rg) > 24 Then
                coche_sauvegarde_mensuelle.Enabled = True
            End If
        Case 4, 6, 9, 11
            If Day(rg) > 23 Then
                coche_sauvegarde_mensuelle.Enabled = True
            End If
        Case 2
            If Year(rg) Mod 4 = 0 Then
                If Day(rg) > 22 Then
                    coche_sauvegarde_mensuelle.Enabled = True
                End If
            Else
                If Day(rg) > 21 Then
                    coche_sauvegarde_mensuelle.Enabled = True
                End If
            End If
    End Select
End If

Cordialement

KD
 
Vote positif 0 Vote négatif
I

Imer2007

XLDnaute Occasionnel
Re : VBA : 1ere et dernière date du mois (ouvrés)

Bonjour,

Bonne nouvelle KD, ca marche impec ! :)

J'aimerais juste l'améliorer (je sais je suis chiant ! ^^ ) sur un point. Actuellement, je choisis la date via la combobox, or ce qui serait parfait finalement serait d'afficher la date du jour automatiquement.

Que dois-je changer dans ton code ?
 
Vote positif 0 Vote négatif

Discussions similaires

chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Simplifier un code fonctionnel
Réponses
2
Affichages
258
chaelie2015
chaelie2015
E
  • Question
Microsoft 365 VBA Calendrier, rien ne se passe.
Réponses
12
Affichages
602
fanch55
fanch55
S
  • Résolu(e)
Microsoft 365 Inscrire automatiquement la date du jour et bloquer les cellules
Réponses
4
Affichages
416
sebastien176
S
M
  • Question
XL 2010 Compter les jours du mois en fonction des date de débuts et fin
Réponses
1
Affichages
431
JHA
J
U
  • Résolu(e)
Autres Mettre en couleur ligne avec VBA car MFC occupées (Excel 2003)
2
Réponses
15
Affichages
1 K
un internaute
U
U
  • Question
Autres [RESOLU] Application.ScreenUpdating = False
Réponses
4
Affichages
889
un internaute
U
D
  • Résolu(e)
Microsoft 365 Ajouter une date de création automatique selon colonne A et une date de modification selon colonne F
Réponses
1
Affichages
400
Phil69970
Phil69970
C
  • Résolu(e)
XL 2016 Remplir automatiquement un tableau d'après des conditions et des valeurs
Réponses
11
Affichages
1 K
ERIC S
ERIC S
D
  • Question
XL 2019 Exécuter une procédure à une heure définie (plannification)
2
Réponses
25
Affichages
3 K
patricktoulon
patricktoulon
K
  • Question
XL 2016 From Excel to Outlook - Déclenchement sur la date et arrêt de la macro
Réponses
3
Affichages
740
AtTheOne
AtTheOne

Membres actuellement en ligne

14 membres et 143 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 104
Messages
2 085 337
Membres
102 865
dernier inscrit
FreyaSalander