VBA PB n° de semaine

Arpette · 1 Août 2010

Bonjour le forum, j'ai un problème avec mon n° de semaine. Nous somme le 1/08/2010 et en semaine 31, ma formule affiche 30. Je ne comprends pas.Ci-joint mon code.
Merci de votre aide

Private Sub Worksheet_Activate()
Application.ScreenUpdating = False

Dim Sme As Byte

Sme = DatePart("ww", Date, 2, 2)
Cells(1, 1) = "Semaine n° " & Sme

datedep = CDate("1/1/" & Year(Date))
For D = datedep To CDate("1/1/" & Year(Date) + 1)
If DatePart("ww", D, 2, 2) = Sme Then
Cells(2, 1) = "Du " & D & " au " & D + 6
Exit For
End If
Next
Application.ScreenUpdating = True
End Sub

youky(BJ) · 5 Août 2010

Re : VBA PB n° de semaine

Bonjour Arpette,
Ton code à l'air de fonctionner. . .
J'ai malgrés tout fait la macro avec une autre méthode, je l'ai bien testé, je passe à la semaine suivante si la date tombe un samedi ou dimanche (en principe le samedi est sauté aussi?).
Pour tester au lieu de >>>d=Date ..mettre en macro exemple.. d="08/02/2011"
mon code est plus allégé aussi
Bruno

Code:

Private Sub Workbook_Open()
Dim c As Range
Dim depart As Date
Dim d As Variant
Dim ns As Date
If Sheets("Récap_Mensuelle").Cells(4, 1) = "" Then Exit Sub
d = Date '"02/01/2011"
d = DateSerial(Year(d), Month(d), 1) 'Date départ au 1er du mois

depart = d - ((d - 2) Mod 7) 'lundi avant d
If Weekday(d, 2) > 5 Then depart = depart + 7 '+1semaine si samedi ou dimanche

Sheets("Récap_Mensuelle").Cells(4, 1) = _
UCase("MOIS DE" & " " & Format(d, "mmmm") & " " & Format(d, "yyyy"))
With Sheets("Relevé_Hebdo")
.Unprotect
.Cells(1, 1) = UCase("MOIS DE" & " " & Format(d, "mmmm") & " " & Format(d, "yyyy"))
  For Each c In .Range("C1,E1,G1,I1,K1")
    ns = DateSerial(Year(depart + (8 - Weekday(depart)) Mod 7 - 3), 1, 1)
    c.Value = "Sem " & ((depart - ns - 3 + (Weekday(ns) + 1) Mod 7)) \ 7 + 1
    depart = depart + 7
  Next
.Protect
End With
End Sub

Arpette · 5 Août 2010

Re : VBA PB n° de semaine

youky(BJ) à dit:
Bonjour Arpette,
Ton code à l'air de fonctionner. . .
J'ai malgrés tout fait la macro avec une autre méthode, je l'ai bien testé, je passe à la semaine suivante si la date tombe un samedi ou dimanche (en principe le samedi est sauté aussi?).
Pour tester au lieu de >>>d=Date ..mettre en macro exemple.. d="08/02/2011"
mon code est plus allégé aussi
Bruno

Code:

Private Sub Workbook_Open() Dim c As Range Dim depart As Date Dim d As Variant Dim ns As Date If Sheets("Récap_Mensuelle").Cells(4, 1) = "" Then Exit Sub d = Date '"02/01/2011" d = DateSerial(Year(d), Month(d), 1) 'Date départ au 1er du mois depart = d - ((d - 2) Mod 7) 'lundi avant d If Weekday(d, 2) > 5 Then depart = depart + 7 '+1semaine si samedi ou dimanche Sheets("Récap_Mensuelle").Cells(4, 1) = _ UCase("MOIS DE" & " " & Format(d, "mmmm") & " " & Format(d, "yyyy")) With Sheets("Relevé_Hebdo") .Unprotect .Cells(1, 1) = UCase("MOIS DE" & " " & Format(d, "mmmm") & " " & Format(d, "yyyy")) For Each c In .Range("C1,E1,G1,I1,K1") ns = DateSerial(Year(depart + (8 - Weekday(depart)) Mod 7 - 3), 1, 1) c.Value = "Sem " & ((depart - ns - 3 + (Weekday(ns) + 1) Mod 7)) \ 7 + 1 depart = depart + 7 Next .Protect End With End Sub

Bonjour Bruno, merci de ta réponse mais il y quelques anomalies. Sur la cellule(4,1) si est elle vide je continue sinon je sort. Si je met date au 01/08/2010 ça met mois d'Août, alors que le dimanche est sur Juillet. Si je met date au 02/01/2010 la semaine 53 se met sur Janvier alors qu'elle fait partie de décembre 2009. Merci encore
@+

youky(BJ) · 5 Août 2010

Re : VBA PB n° de semaine

Erreur de ma part il faut . . .
If Sheets("Récap_Mensuelle").Cells(4, 1)<> "" Then Exit Sub

>> Si je met date au 01/08/2010 ça met mois d'Août
Cela correspond du 02/08 au 08/08 donc pour moi c'est aout
idem 02/01/2010 sem53 à sem4 cela est bien le mois de 01

Bon pour faire comme tu dis ici il faut mettre "depart" au lieu "d" sur les 2 lignes
UCase("MOIS DE" & " " & Format(depart, "mmmm") & " " & Format(depart, "yyyy"))

Bruno

Arpette · 5 Août 2010

Re : VBA PB n° de semaine

youky(BJ) à dit:
Erreur de ma part il faut . . .
If Sheets("Récap_Mensuelle").Cells(4, 1)<> "" Then Exit Sub

>> Si je met date au 01/08/2010 ça met mois d'Août
Cela correspond du 02/08 au 08/08 donc pour moi c'est aout
idem 02/01/2010 sem53 à sem4 cela est bien le mois de 01

Bon pour faire comme tu dis ici il faut mettre "depart" au lieu "d" sur les 2 lignes
UCase("MOIS DE" & " " & Format(depart, "mmmm") & " " & Format(depart, "yyyy"))

Bruno

Désolé Bruno, mais c'est pas bon. Si je met 01/08/2010 je suis sur Août, alors que le Dimanche fait partie de le semaine 30 Juillet et pour le 02/01/2010 semaine 53 renvoi bien décembre 2009 mais semaines 53,01,02,03,04.
Je te joints le fichier avec tes modifs et essayes ma macro ( qui est un peu, beaucoup la tienne) elle fonctionne dans tous les cas. Après j'ai encore besoin de ton aide...Je t'expliquerai
@+

Arpette · 6 Août 2010

Re : VBA PB n° de semaine

Arpette à dit:
Désolé Bruno, mais c'est pas bon. Si je met 01/08/2010 je suis sur Août, alors que le Dimanche fait partie de le semaine 30 Juillet et pour le 02/01/2010 semaine 53 renvoi bien décembre 2009 mais semaines 53,01,02,03,04.
Je te joints le fichier avec tes modifs et essayes ma macro ( qui est un peu, beaucoup la tienne) elle fonctionne dans tous les cas. Après j'ai encore besoin de ton aide...Je t'expliquerai
@+

Bonsoir à tous,
me revoilà avec mes n° de semaines. Cette fois je souhaiterais vérifier en fin de macro dans ThisWorkbook, si la première 1er semaine du mois suivant correspond à la semaine qui se trouve dans la feuille Relevé_Hebdo en K1, j'efface K1 car mois de 4 semaines.

Merci de votre aide

youky(BJ) · 6 Août 2010

Re : VBA PB n° de semaine

Bonsoir Arpette,
j'ai regardé et oui parfois les N° semaines se retrouvent sur le mois en cours et le mois suivant ou vis versa sur le mois précédant et le mois en cours.
Pas facile de dire telle semaine est a mettre sur le mois en cours ou sur le mois suivant.
Il faut faire ton choix, par exemple cette année 2010 sem13 du 29/03 au 04/04 soit 3 jours en mars et 4 jours en avril, compte tenu qu'avril inclu un week-end.
Question..... sur quel mois placer cette semaine???
Je parle pas des jours fériés.
Nous rentrons direct dans une usine à gaz . . . .!
Bruno

Arpette · 7 Août 2010

Re : VBA PB n° de semaine

youky(BJ) à dit:
Bonsoir Arpette,
j'ai regardé et oui parfois les N° semaines se retrouvent sur le mois en cours et le mois suivant ou vis versa sur le mois précédant et le mois en cours.
Pas facile de dire telle semaine est a mettre sur le mois en cours ou sur le mois suivant.
Il faut faire ton choix, par exemple cette année 2010 sem13 du 29/03 au 04/04 soit 3 jours en mars et 4 jours en avril, compte tenu qu'avril inclu un week-end.
Question..... sur quel mois placer cette semaine???
Je parle pas des jours fériés.
Nous rentrons direct dans une usine à gaz . . . .!
Bruno

Bonjour Bruno, pour moi la semaine 13 est sur le mois d'avril car 4 jour sur le mois. Les jours fériés n'ont pas d'importance, mon tableau est pour une maison de retraite et les semaines vont du lundi au dimanche. Par contre je cherche comment faire si je me place au premier mars ne pas avoir la semaine 13 sur mars puisqu'elle fait partie d'avril. Ci-joint la partie du code qui détermine de quel mois fais parti la semaine. Merci pour ton aide.

Code:

D = Date
    j = D + 1 - DatePart("w", D, vbMonday, vbFirstFourDays)
    mois = Format(j + 3, "mmmm") 'mois contenant au moins 4 jours de la semaine.
    Année = Format(DateDepart, "yyyy")

youky(BJ) · 7 Août 2010

Re : VBA PB n° de semaine

Bonjour,
Tests concluants pour moi, à toi de voir si ca te va. . .
Tu remetteras D=Date car pour les essais je mets la date en chiffre
Bruno

Code:

Private Sub Workbook_Open()
Dim c As Range
Dim depart As Date
Dim D As Variant
Dim ns As Date
If Sheets("Récap_Mensuelle").Cells(4, 1) <> "" Then Exit Sub
D = "02/07/2010"
D = DateSerial(Year(D), Month(D), 1) 'Date départ au 1er du mois

depart = D - ((D - 2) Mod 7) 'lundi avant d
If Weekday(D, 2) > 5 Then depart = depart + 7 '+1semaine si samedi ou dimanche

Sheets("Récap_Mensuelle").Cells(4, 1) = _
UCase("MOIS DE" & " " & Format(depart, "mmmm") & " " & Format(depart, "yyyy"))
With Sheets("Relevé_Hebdo")
.Unprotect
[COLOR="red"].Range("C1,E1,G1,I1,K1") = ""[/COLOR]
.Cells(1, 1) = UCase("MOIS DE" & " " & Format(depart, "mmmm") & " " & Format(depart, "yyyy"))
  For Each c In .Range("C1,E1,G1,I1,K1")
    ns = DateSerial(Year(depart + (8 - Weekday(depart)) Mod 7 - 3), 1, 1)
   [COLOR="Red"] If Month(depart + 7) > Month(D) And Day(depart + 7) > 4 Then Exit For[/COLOR]
    c.Value = "Sem " & ((depart - ns - 3 + (Weekday(ns) + 1) Mod 7)) \ 7 + 1
    depart = depart + 7
  Next
.Protect
End With
End Sub

Arpette · 9 Août 2010

Re : VBA PB n° de semaine

youky(BJ) à dit:

Bonjour,
Tests concluants pour moi, à toi de voir si ca te va. . .
Tu remetteras D=Date car pour les essais je mets la date en chiffre
Bruno

Code:

Private Sub Workbook_Open()
Dim c As Range
Dim depart As Date
Dim D As Variant
Dim ns As Date
If Sheets("Récap_Mensuelle").Cells(4, 1) <> "" Then Exit Sub
D = "02/07/2010"
D = DateSerial(Year(D), Month(D), 1) 'Date départ au 1er du mois

depart = D - ((D - 2) Mod 7) 'lundi avant d
If Weekday(D, 2) > 5 Then depart = depart + 7 '+1semaine si samedi ou dimanche

Sheets("Récap_Mensuelle").Cells(4, 1) = _
UCase("MOIS DE" & " " & Format(depart, "mmmm") & " " & Format(depart, "yyyy"))
With Sheets("Relevé_Hebdo")
.Unprotect
[COLOR="red"].Range("C1,E1,G1,I1,K1") = ""[/COLOR]
.Cells(1, 1) = UCase("MOIS DE" & " " & Format(depart, "mmmm") & " " & Format(depart, "yyyy"))
  For Each c In .Range("C1,E1,G1,I1,K1")
    ns = DateSerial(Year(depart + (8 - Weekday(depart)) Mod 7 - 3), 1, 1)
   [COLOR="Red"] If Month(depart + 7) > Month(D) And Day(depart + 7) > 4 Then Exit For[/COLOR]
    c.Value = "Sem " & ((depart - ns - 3 + (Weekday(ns) + 1) Mod 7)) \ 7 + 1
    depart = depart + 7
  Next
.Protect
End With
End Sub

Bonjour Bruno et merci pour toute ton aide. Mon programme est terminé, j'ai mixé ta macro avec la mienne car dans la tienne si date = 02/01/2010 mois = Janvier, alors que les 1,2 et 3 sont sur la semaine 53 qui est sur décembre. Mais j'ai pris la partie de ma macro qui calcule comme je le souhaite et rajouté ta partie qui qui supprime ou non la 5ème semaine.
Encore un grand merci à toi, ça ma permis de bien progresser en VBA
@

VBA PB n° de semaine

Arpette

XLDnaute Impliqué

youky(BJ)

XLDnaute Barbatruc

Arpette

XLDnaute Impliqué

youky(BJ)

XLDnaute Barbatruc

Arpette

XLDnaute Impliqué

Pièces jointes

Arpette

XLDnaute Impliqué

youky(BJ)

XLDnaute Barbatruc

Arpette

XLDnaute Impliqué

youky(BJ)

XLDnaute Barbatruc

Arpette

XLDnaute Impliqué

Discussions similaires

VBA PB n° de semaine

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

Pièces jointes

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

Discussions similaires

Privacy & Transparency

Privacy & Transparency