Re : Vba renvoyer n° de semaine
Bonsoir et merci à tous les deux. Les deux macro fonctionnent à merveille. Le seul problème est que dans celle Hasco ça renvoie le mois de septembre en A1et dans celle de Cmoa le début de mois est renseigné dans les variables. Ce fichier est mis à jour tous les mois et prend le mois du système.
Merci encore à tous les deux pour votre aide.
Re, j'ai trouvé la solution en mettant en variable
Dim DateDepart As Date: DateDepart = Month(Date)
je vous joints la macro. Il me reste le problème de la semaine 53
j'ai une fonction qui tient compte de la semaine 53, mais je ne sais pas où la placer.
Macro
Private Sub Workbook_Open()
Sheets("Récap_Mensuelle").Select
If Cells(4, 1) = Empty Then
Dim Mois As String
Dim Année As String
Dim Titre As String
Dim Récap_Mensuelle As String
Dim Relevé_Hebdo As String
Dim semaine As String
Dim Sme As String
Dim c As Range
Dim DateDepart As Date: DateDepart = Month(Date)
Sheets("Récap_Mensuelle").Select
Mois = Format(Now, "mmmm")
Année = Format(Now, "yyyy")
Titre = "MOIS DE" & " " & Mois & " " & Année
Cells(4, 1) = UCase(Titre)
Sheets("Relevé_Hebdo").Select
Worksheets("Relevé_Hebdo").Unprotect
Mois = Format(Now, "mmmm")
Année = Format(Now, "yyyy")
Titre = "MOIS DE" & " " & Mois & " " & Année
Cells(1, 1) = UCase(Titre)
'Cells(1, 1) = "Mois de " & UCase(Format(DateDepart, "mmmm"))
'Attention nous avons à faire à des cellules fusionnées!
'il faut donc alimenter 1 cellule sur 2 à partir de C1
For Each c In Range("C1,E1,G1,I1,K1")
c = "Sem " & DatePart("ww", DateDepart, vbMonday, vbFirstFourDays)
DateDepart = DateDepart + 7 'Incrémenter la date de 7 jours (1 semaine)
Next
Worksheets("Relevé_Hebdo").Protect
End If
End Sub
La funcion
Function CLSC(Dates As Date) As Integer
Dim semaine As Integer
semaine = Int((Dates - DateSerial(Year(Dates), 1, 1) + _
((Weekday(DateSerial(Year(Dates), 1, 1)) + 1) _
Mod 7) - 3) / 7) + 1
If semaine = 0 Then
semaine = CLSC(DateSerial(Year(Dates) - 1, 12, 31))
ElseIf semaine = 53 And (Weekday(DateSerial(Year(Dates), 12, 31)) - 1) _
Mod 7 <= 3 Then
semaine = 1
End If
CLSC = semaine
End Function