Probleme macro sur la semaine 1 de 2025

Bonjour à tous,

J'ai besoin d'un coup de pouce de votre part.

J'utilise une macro qui fonctionne par N° de semaine. Le soucis rencontré est que la semaine1 de 2025 n'est pas prise en compte, je passe donc de la semaine 52(2024) à la semaine 2(2025).

noSem = ActiveSheet.Cells(6, 2)
    If noSem <= 0 Or noSem > 53 Then
        'MsgBox "Le numéro de semaine est incorect !", vbCritical
        Exit Sub
    End If

    Dim noAn As Integer
    noAn = ActiveSheet.Cells(2, 1)
    If noAn < 2020 Or noAn > 2100 Then
        MsgBox "L'année est incorrecte !", vbCritical
        Exit Sub
    End If

    Dim curAn As Integer
    Dim dtedeb As Date
    Dim dtefin As Date

    'curAn = Year(Now())
    curAn = noAn

    If Weekday(DateSerial(curAn, 1, 1)) = 1 Or Weekday(DateSerial(curAn, 1, 1)) = 2 Then

        dtedeb = DateSerial(curAn, 1, 1) - Weekday(DateSerial(curAn, 1, 1)) - 5 + 7 * noSem
        dtefin = dtedeb + 6

    Else
        dtedeb = DateSerial(curAn, 1, 1) - Weekday(DateSerial(curAn, 1, 1)) - 5 + 7 * (noSem + 1)
        dtefin = dtedeb + 6

    End If
    Sheets(feuil_repas).Cells(4, 8) = Format(dtedeb, "mm/dd/yyyy")
    Sheets(feuil_repas).Cells(4, 12) = Format(dtefin, "mm/dd/yyyy")

    dtedebrqt = Format(dtedeb, "yyyy-mm-dd 00:00")
    dtefinrqt = Format(dtefin, "yyyy-mm-dd 23:59")

En modifiant cette ligne

dtedeb = DateSerial(curAn, 1, 1) - Weekday(DateSerial(curAn, 1, 1)) - 5 + 7 * (noSem + 1)

Par cette ligne, la semaine 1 est bien prise en compte

dtedeb = DateSerial(curAn, 1, 1) - Weekday(DateSerial(curAn, 1, 1)) - 5 + 7 * noSem 

En vous remerciant pour votre aide

Bonjour,

Comme indiqué dans la charte, Il faudrait joindre votre fichier anonymisé également

Sinon comment savoir ce que contient

noSem = ActiveSheet.Cells(6, 2)

A+

Bonjour,

Par défaut Weekday (et la Fonction NO.SEMAINE - Support Microsoft, que j'imagine vous utilisez dans Activesheet.cells(6,2)), commencent le dimanche (et non lundi). Verifiez si ça ne change pas quelque chose.

Ensuite… quel est le problème ? Vous donnez la solution en bas de votre message je suis confus. Si vous pouviez joindre un fichier avec la macro complète.

Merci pour ton aide

Malheureusement, mon fichier est beaucoup trop lourd pour le poster en entier mais je joins un extrait

Pour etre plus précis, je vais chercher des données sur un serveur (connexion bdd)

Je recupere les données (des effectifs) sur une semaine entière (du lundi au dimanche)

Cependant, la transition exceptionnelle entre 2024 et 2025 se fait en milieu de semaine, mercredi 01 janvier 2025. Le probleme est que la macro zappe la semaine du 28/12/2024 au 5/01/2025 et ne me récolte pas les bonnes données. elle crée un décalage, et récupére les données de semaine suivante (Semaine+1) du 06/01/2025 au 12/01/2025.

"noSem" fait référence à l'année qui est saisie manuellement. Pour exemple la saisie va etre "2025"

noSem = ActiveSheet.Cells(6, 2)

Je poste ma macro complète ci dessous

Sub rqt_eff1() 'SAJ

    Dim feuil_repas As String
    Dim feuil_cde As String
    feuil_repas = "1" '-----Modifier
    'feuil_cde = "SAJ" '-----Modifier
    Dim idEtb As Integer
    idEtb = 1 '-----Modifier
    Dim idRest As Integer
    idRest = 1

    '-------------------- REPAS--------------------
    Sheets(feuil_repas).Activate

    '---- Effacement  -------
    r_lgndeb1 = 9
    r_lgnfin1 = 31
    r_lgndeb2 = 35
    r_lgnfin2 = 35
    r_coldeb = 6
    r_colfin = 32
    Sheets(feuil_repas).Range(Sheets(feuil_repas).Cells(r_lgndeb1, r_coldeb), Sheets(feuil_repas).Cells(r_lgnfin1, r_colfin)).ClearContents
    Sheets(feuil_repas).Range(Sheets(feuil_repas).Cells(r_lgndeb2, r_coldeb), Sheets(feuil_repas).Cells(r_lgnfin2, r_colfin)).ClearContents

    '---- Définition intervalle dates  --------------
    Dim noSem As Integer
    noSem = ActiveSheet.Cells(6, 2) '--modifier
    On Error GoTo GestionErreur:
    If noSem <= 0 Or noSem > 53 Then
        Sheets("TAB").Activate
        Range("B2").Select
GestionErreur:
        MsgBox "Le numéro de semaine " & (ActiveCell.Value) & " est incorrect !", vbCritical

End
        Exit Sub
    End If

    Dim noAn As Integer
    noAn = ActiveSheet.Cells(2, 1)
    If noAn < 2020 Or noAn > 2100 Then
        MsgBox "L'année est incorrecte !", vbCritical
        Exit Sub
    End If

    Dim curAn As Integer
    Dim dtedeb As Date
    Dim dtefin As Date

    'curAn = Year(Now())
    curAn = noAn
    If Weekday(DateSerial(curAn, 1, 1)) = 1 Or Weekday(DateSerial(curAn, 1, 1)) = 2 Then
        dtedeb = DateSerial(curAn, 1, 1) - Weekday(DateSerial(curAn, 1, 1)) - 5 + 7 * noSem
        dtefin = dtedeb + 6
    Else
        dtedeb = DateSerial(curAn, 1, 1) - Weekday(DateSerial(curAn, 1, 1)) - 5 + 7 * (noSem + 1)
        dtefin = dtedeb + 6
    End If
    Sheets(feuil_repas).Cells(4, 8) = Format(dtedeb, "mm/dd/yy")
    Sheets(feuil_repas).Cells(4, 12) = Format(dtefin, "mm/dd/yy")

    dtedebrqt = Format(dtedeb, "yyyy-mm-dd 00:00")
    dtefinrqt = Format(dtefin, "yyyy-mm-dd 23:59")

    '--- Connexion bdd  --------------------------------
    Dim Cnx As ADODB.Connection, rst As ADODB.Recordset, rst2 As ADODB.Recordset

    Set Cnx = New ADODB.Connection
    Cnx.Open "Driver={MySQL ODBC 5.3 UNICODE Driver};Server=10.3.5.192;Database=resto;User=resto_read;Password=dwwWsdmZD93kgwJHJwDFVLW7bMxeqFaQ;Option=3"

    '---- Rqt repas  -----------------------------------
    Dim rqt As String

    rqt = rqt & "SELECT cde.date, cde.establishment_id, cde.restaurant_id, cde.number_out_of_time, nb.meal_type_id, nb.number "
    rqt = rqt & "FROM meals_command as cde, number_of_meals as nb "
    rqt = rqt & "WHERE cde.ID = nb.command_id "
    rqt = rqt & "  AND cde.restaurant_id = " & idRest & " AND cde.establishment_id = " & idEtb & " "
    rqt = rqt & "  AND cde.date BETWEEN '" & dtedebrqt & "' AND '" & dtefinrqt & "'"

    Set rst = New ADODB.Recordset
    rst.Open rqt, Cnx

    Dim lgn As Integer
    lgn = 9 '--modifier
    Dim lgnHD As Integer
    lgnHD = 35 '-- modifier

    Dim errIdRepas As String
    errIdRepas = ""

    While Not (rst.EOF)
        dteRepas = rst.Fields(0).Value
        nbRepasHD = rst.Fields(3).Value
        idRepas = rst.Fields(4).Value
        qteRepas = rst.Fields(5).Value

        '- colonne du fichier excel
        c = 0
        If Mid(dteRepas, 12, 2) = 12 Then
            'midi
            c = 4 * Weekday(dteRepas, vbMonday) + 2
        Else
            'soir
            c = 4 * Weekday(dteRepas, vbMonday) + 4
        End If

        '- ligne du fichier excel
        For l = 9 To 35 '--modifier
            If idRepas = Sheets(feuil_repas).Cells(l, 1) Then
                Exit For
            End If
        Next
        If l = 35 Then '--modifier
            errIdRepas = errIdRepas & "id repas inconnu : " & idRepas & " / " & CStr(dteRepas) & " / qté " & qteRepas & vbCrLf
        End If

        '---  qté  ---
        If c <> 0 And l <= 35 Then
            Sheets(feuil_repas).Cells(l, c) = qteRepas
        End If

        If nbRepasHD > 0 Then
            Sheets(feuil_repas).Cells(lgnHD, c) = nbRepasHD
        End If

        lgn = lgn + 1
        rst.MoveNext

    Wend
    rst.Close
    Set rst = Nothing

    '--- Fermeture bdd  ---------------------------------
    Cnx.Close
    Set Cnx = Nothing

    '--- Alertes erreurs identifiants non trouvés dans le fichier excel
    If errIdRepas <> "" Then
        'MsgBox "Erreurs repas :" & vbCrLf & errIdRepas, vbInformation
    End If
    'Sheets(feuil_repas).Activate
End Sub

Peut etre

Actuellement il est ecrit dans cet ordre "noSem" puis "noSem+1"

curAn = noAn
    If Weekday(DateSerial(curAn, 1, 1)) = 1 Or Weekday(DateSerial(curAn, 1, 1)) = 2 Then
        dtedeb = DateSerial(curAn, 1, 1) - Weekday(DateSerial(curAn, 1, 1)) - 5 + 7 * noSem
        dtefin = dtedeb + 6
    Else
        dtedeb = DateSerial(curAn, 1, 1) - Weekday(DateSerial(curAn, 1, 1)) - 5 + 7 * (noSem + 1)
        dtefin = dtedeb + 6
    End If

Mais cela fonctionne dans ce sens la : "noSem+1" puis "noSem"

curAn = noAn
    If Weekday(DateSerial(curAn, 1, 1)) = 1 Or Weekday(DateSerial(curAn, 1, 1)) = 2 Then
        dtedeb = DateSerial(curAn, 1, 1) - Weekday(DateSerial(curAn, 1, 1)) - 5 + 7 * (noSem + 1)
        dtefin = dtedeb + 6
    Else
        dtedeb = DateSerial(curAn, 1, 1) - Weekday(DateSerial(curAn, 1, 1)) - 5 + 7 * noSem 
        dtefin = dtedeb + 6
    End If

Bonjour,
Pour calculer le bon lundi d'une semaine (ISO 8601), essaie d'utiliser cette fonction personnalisée.
Cdlt.

Option Explicit
'ISO 8601
Public Function MondayInWeek(year As Integer, week As Integer)
Dim dt As Date, weeks As Integer, dow As Integer
    dt = DateSerial(year, 1, -2)
    weeks = WorksheetFunction.IsoWeekNum(DateSerial(year, 12, 28))
    dow = Weekday(dt, 3)
    If week > 0 And week <= weeks Then
        MondayInWeek = dt - dow + week * 7
    Else
        MondayInWeek = vbNullString
    End If
End Function

oubien

Public Function MondayInWeek2(year As Integer, week As Integer)
     MondayInWeek2 = WorksheetFunction.WorkDay_Intl(DateSerial(year - 1, 12, 28), week, "0111111")
     If WorksheetFunction.IsoWeekNum(MondayInWeek2) <> week Then MondayInWeek2 = "Erreur"
End Function

Bonjour,
@Bart,
J'aime bien mon approche pédagogique !...

Merci à vous deux je vais tester dès demain

Bonjour,

En fait je ne sais pas trop si je dois apporter des modifications à la macro?

curAn = noAn
    If Weekday(DateSerial(curAn, 1, 1)) = 1 Or Weekday(DateSerial(curAn, 1, 1)) = 2 Then
        dtedeb = DateSerial(curAn, 1, 1) - Weekday(DateSerial(curAn, 1, 1)) - 5 + 7 * (noSem + 1)
        dtefin = dtedeb + 6
    Else
        dtedeb = DateSerial(curAn, 1, 1) - Weekday(DateSerial(curAn, 1, 1)) - 5 + 7 * noSem 
        dtefin = dtedeb + 6
    End If

et dois je simplement coller l'une de vos propositions dans le module ou plutot thisworkbook?

re,

Pour l'Iso-semaine 1, il faut trouver le lundi entre 28/12 et 5/1, le 4 janvier est toujours dans la iso-semaine 1, Donc il ne faut pas compliquer les choses.