XL 2016 fichier de statistiques par semaine dans l'année en vba

mastergate

XLDnaute Nouveau
bonjour a tous,
je suis novice en vba, je cherche a créer un fichier de statistique suivant des règles définit.
Ce fichier me servira a créer des stats par semaine,
j'ai le bouton (avec vba) qui me permet de créer une nouvelle feuille identique avec en nom le numéro de la semaine,
jai des boutons permettant de mettre a jour des données rentrées par jour,

Ma demande est celle si, j'aimerais savoir en vba s'il existe une façon de faire pour que mes boutons journalier(lundi, mardi, ...) ne puissent mettre a jour que le jour correspondant en choisissant le numéro de la semaine que l'on veut mettre a jour???

et aussi, sur la nouvelle feuille créer (ex: semaine 10) existe t il une fonction qui permettrait de geler le numéro de semaine (c2) pour ne pas que cela ce mette a jour si on consulte cette feuille après???

merci d'avance pour l'aide que vous pourrez m'apporter
 

Pièces jointes

  • demande excel.xlsm
    45.9 KB · Affichages: 18
Solution
Bonne Nuit @mastergate , bonne nuit les noctambules ...

La réponse à tes 2 questions est Oui, bonne nouvelle non ?
Ma demande est celle si, j'aimerais savoir en vba s'il existe une façon de faire pour que mes boutons journalier(lundi, mardi, ...) ne puissent mettre a jour que le jour correspondant en choisissant le numéro de la semaine que l'on veut mettre a jour???
Ma démarche :

J'ai d'abord nommer tes boutons Bt_Lundi, Bt_Mardi, ... Ça se fait en sélectionnant le bouton et en tapant le nom dans la zone de nom, sans oublier de valider par ENTREE :
1642036276949.png


Ensuite j'ai créé une macro unique pour tous les jours, elle détecte le bouton qui l'a lancé grâce à la propriété...

AtTheOne

XLDnaute Impliqué
Supporter XLD
Bonjour à toutes & à tous
on me demande de rajouter des lignes, et évidemment par ordre alphabétique, est ce que je peut en insérer ou non, et les macros les prendront elles en comptes ???
Après l'ajout de lignes, tu as juste à mettre à jour 2 noms définis :

_Stat_Hebdo=!$D$4:$J$75
_Stat_Mensuelles=Stats_Mensuelles!$D$4:$N$75

par exemple si tu ajoutes 3 lignes, en modifiant le 75 par 78 :

1649244137581.png

Tu fais cela à partir de la feuille "SAISIES STAT HEBDO" que tu déverrouilles temporairement.
Ça devrait rouler tout seul ensuite.
(Si tu as procédé par insertion, le nom "_Stat_Mensuelles" sera mis à jour automatiquement (mais pas le nom "_Stat_Hebdo")

Amicalement
Alain
 

AtTheOne

XLDnaute Impliqué
Supporter XLD
Re
ou je dois aussi rajouter les lignes dans le tableau mensuel???
Tu dois aussi rajouter les lignes dans le tableau mensuel, mais là le nom "_Stat_Mensuelles" suivra la modification (sauf si tu ne procèdes pas par insertion),
On pourrait prévoir une macro pour faire cela, mais si ça ne change pas tous les quatre matins, ce n'est peut-être pas la peine ...
Modif : si tu enlèves la protection de toutes les feuilles à modifier , tu peux toutes les sélectionner et faire les modifs en une seule fois (insertion, nom des catégories et des motifs) puisque les lignes se correspondent et que les colonnes qui contiennent les libellés sont les mêmes.
Amicalement
Alain
 
Dernière édition:

mastergate

XLDnaute Nouveau
Alors je vient de faire le test, j'ai créer un ligne au milieu des feuilles de stats journalier et mensuelles (a la meme position), refaits les semaines du mois en cours pour tester, jai mis a jour les noms comme les apercu, mais en faisant stats mansuelle pour le mois en cours, la nouvelles lignes ne se met pas a jour, et j'ai #N/A en bas du mois qui s'affiche ???
 

Pièces jointes

  • HP test statistique 2022.xlsm
    38.7 KB · Affichages: 1

AtTheOne

XLDnaute Impliqué
Supporter XLD
Re
Bon il y avait plusieurs problèmes :
  1. la nouvelles lignes ne se met pas a jour
    Il faut copier la formule dans la colonne Total dans les nouvelles lignes (pour les semaines et pour le mensuel) car c'est cette colonne que j'utilise pour transférer les stats hebdos vers les stats mensuelles.
    Il faut aussi recopier le nom de la catégorie dans ces nouvelles lignes (incidence sur le format conditionnel.)
    Je te conseille de recopier le format de la 1ère ligne de stat sur toute la plage de stats pour homogénéiser ces formats.


  2. et j'ai #N/A en bas du mois qui s'affiche ???
    Il faut que tu reprennes les modifications de code qui suivent (j'avais stocké le nombre de lignes de stats dans une constantes "Nb_Lgn_Stat = 72", on pourrait se contenter de la passer à 73, mais je préfère me baser sur le nombre de lignes de la plage "_Stat_Mensuelles" qui varie automatiquement).
    Donc 3 modifs à faire :
Module C00_Constantes à remplacer par ce code (on supprime une ligne ) :
Enrichi (BBcode):
Public Const Sh_Saisie_Semaine As String = "SAISIES STAT HEBDO"      'Nom de la feuille de saisie
Public Const Sh_Stat_Mensuelles As String = "Stats_Mensuelles"      'Nom de la feuille des stat mensuelles
Public Const Préfixe As String = "Semaine_"                         'Préfixe des nouvelles feuilles
Public Const Adr_N°_An As String = "$A$1"                           'Adresse de l'année
Public Const Adr_N°_S As String = "$C$2"                            'Adresse du N° de semaine
Public Const Plg_Données  As String = "_Stat_Hebdo"                 'Adresse de la plage de données
Public Const Plg_Stat_Mensuelles = "_Stat_Mensuelles"               'Adresse de la plage de statistiques mensuelles
Module M00_Variables_Publiques à remplacer par ce code (on ajoute une ligne)
Enrichi (BBcode):
Public Année As Integer
Public Mois_Choisi As Byte
Public Tb_Mois()
Public TBS(), TBA(), TBD(), TBF(), Tb_Temp(), TbIdx()
Public Premier_J As Date, Dernier_Jour As Date, SDéb As Integer, SFin As Integer
Public Nb_Lgn_Stat As Integer 'Nombre de lignes de stat
Module M02_Stat_Mensuelles, Sub Stat_Mensuelles à remplacer par ce code (Modif en Rouge Gras)
Enrichi (BBcode):
Sub Stat_Mensuelles()

Dim WSh As Worksheet, Wsh_Stat_Mensuelles As Worksheet, i As Byte, j As Byte, Tb_Mois_Disp()
     'Recherche de la feuille de stat mensuelles
     Set Wsh_Stat_Mensuelles = Nothing
     On Error Resume Next
          Set Wsh_Stat_Mensuelles = ThisWorkbook.Worksheets(Sh_Stat_Mensuelles)
     On Error GoTo 0
     If Wsh_Stat_Mensuelles Is Nothing Then
          MsgBox "On ne trouve pas la feuille de statistiques mensuelles !"
          Exit Sub  'Sortie si echec
     End If
     Wsh_Stat_Mensuelles.Protect UserInterfaceOnly:=True
     'Recherche de Feuilles 'Semaine_x'
     i = 0
     For Each WSh In ThisWorkbook.Worksheets
          If WSh.Name Like "Semaine_*" Then
               i = i + 1
               ReDim Preserve TBS(1 To i): ReDim Preserve TBA(1 To i): ReDim Preserve TBD(1 To i): ReDim Preserve TBF(1 To i)
               TBS(i) = CByte(Replace(WSh.Name, "Semaine_", ""))                 'liste des N° de semaine disponibles
               TBA(i) = WSh.Range(Adr_N°_An).Value                               'liste des années pour ces semaine (pour cas 1er janvier)
               TBD(i) = CLng(Lundi_An_Semaine(CDate(TBA(i)), CByte(TBS(i))))     'liste des débuts de semaine (date des lundis en long)
               TBF(i) = TBD(i) + 6                                               'liste des fins de semaine (date des dimanches en long)
          End If
     Next
     If i = 0 Then
          MsgBox "Aucune statistisque hebdomadaire enregistrée !"
          Exit Sub 'Sortie si echec
     End If
     With WorksheetFunction
          Année = .Max(TBA)   'année en cours
          Premier_J = CDate(.Min(TBD))
          Dernier_J = CDate(.Max(TBF))
        
          'Mois disponible pour l'enregistrement
          Tb_Mois = Array("Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Aoüt", "Septembre", "Octobre", "Novembre", "Décembre")
          j = 0
          For i = 1 To 12
               If DateSerial(Année, i, 1) >= Premier_J And .EoMonth(DateSerial(Année, i, 1), 0) <= Dernier_J Then
                    j = j + 1
                    ReDim Preserve Tb_Mois_Disp(1 To j)
                    Tb_Mois_Disp(j) = Tb_Mois(i - 1)
               End If
          Next i
     End With
     If j = 0 Then
          MsgBox "Pas assez de statistiques hebdomadaire pour enregistrer un mois !"
          Exit Sub 'Sortie si aucun mois complet
     End If
     Tb_Mois = Tb_Mois_Disp   'Tb_Mois ne contient que les mois disponibles
  
     'Affichage du formulaire de sélection du mois à enregistrer
     With UsF_Mensuelles
          SDéb = -1: SFin = -1
          .CbB_Liste_Mois.List = Tb_Mois
          .Show
     End With
     Unload UsF_Mensuelles
     If SDéb = -1 And SFin = -1 Then Exit Sub   'Sortie si aucune période choisie
  
     Nb_Lgn_Stat = Wsh_Stat_Mensuelles.Evaluate(Plg_Stat_Mensuelles).Rows.Count
     If Nb_Lgn_Stat <> F01_Semaine.Evaluate(Plg_Données).Rows.Count Then
          MsgBox "Incohérence entre le nombre de lignes de Stats Hebdo et le nombre de lignes de Stats Mensuelles"
          Exit Sub
     End If
     ReDim Tb_Stat_S(1 To Nb_Lgn_Stat, 1 To 1)
     ReDim Tb_Stat_Mois(1 To UBound(Tb_Stat_S, 1), 1 To 1)
  
     'Cas de la 1ère semaine :
     JS = Weekday(DateSerial(Année, Mois_Choisi, 1), vbMonday)
     If JS > 1 Then
          If Not FeuilleExiste("Semaine_" & SDéb) Then
               MsgBox "Il manque l'enregistrement de la semaine " & SDéb
               Exit Sub
          End If
          'Si le jour de début de mois n'est pas un Lundi
          'Ne prendre que les jours du mois
          Set WSh = ThisWorkbook.Worksheets("Semaine_" & SDéb)
          WSh.Protect UserInterfaceOnly:=True
          With WSh.Evaluate(Plg_Données)
               'on mémorise toutes les donnée de la semaine
               Tb_Svg = .Value
               'on efface les données de l'année antérieure
               .Columns(1).Resize(, JS - 1).ClearContents
               'on mémorise la colonne Total
               Tb_Stat_S = .Columns(8).Value
               'On ajoute les valeurs au tableau de stat mensuelles
               For i = 1 To Nb_Lgn_Stat
                    Tb_Stat_Mois(i, 1) = Tb_Stat_Mois(i, 1) + Tb_Stat_S(i, 1)
               Next i
               'On retablit les données effacées
               .Value = Tb_Svg
          End With
          'Pour la boucle sur les semaines complètes on incrémente Sdéb de 1
          SDéb = SDéb + 1
     End If
  
     'Cas de la dernière semaine
     JF = Weekday(WorksheetFunction.EoMonth(DateSerial(Année, Mois_Choisi, 1), 0), vbMonday)
     If JF < 7 Then
          If Not FeuilleExiste("Semaine_" & SFin) Then
               MsgBox "Il manque l'enregistrement de la semaine " & SFin
               Exit Sub
          End If
          'Si le jour de fin de mois n'est pas un dimanche
          'Ne prendre que les jours du mois
          Set WSh = ThisWorkbook.Worksheets("Semaine_" & SFin)
          WSh.Protect UserInterfaceOnly:=True
          With WSh.Evaluate(Plg_Données)
               'on mémorise toutes les donnée de la semaine
               Tb_Svg = .Value
               'on efface les données du mois suivant
               .Columns(1).Offset(, JF).Resize(, 7 - JF).ClearContents
               'on mémorise la colonne Total
               Tb_Stat_S = .Columns(8).Value
               'On ajoute les valeurs au tableau de stat mensuelles
               For i = 1 To Nb_Lgn_Stat
                    Tb_Stat_Mois(i, 1) = Tb_Stat_Mois(i, 1) + Tb_Stat_S(i, 1)
               Next i
               .Value = Tb_Svg
          End With
          'Pour la boucle sur les semaines complètes on décrémente SFin de 1
          SFin = SFin - 1
     End If
  
     'Boucle sur les semaines complètes
     For i = SDéb To SFin
          If Not FeuilleExiste("Semaine_" & i) Then
               MsgBox "Il manque l'enregistrement de la semaine " & i
               Exit Sub
          End If
          Set WSh = ThisWorkbook.Worksheets("Semaine_" & i)
          With WSh
               'on mémorise la colonne Total
               Tb_Stat_S = .Evaluate(Plg_Données).Columns(8).Value
               'On ajoute les valeurs au tableau de stat mensuelles
               For j = 1 To Nb_Lgn_Stat
                    Tb_Stat_Mois(j, 1) = Tb_Stat_Mois(j, 1) + Tb_Stat_S(j, 1)
               Next j
          End With
     Next i
            
     With Wsh_Stat_Mensuelles.Evaluate(Plg_Stat_Mensuelles)
          .Columns(Mois_Choisi).Value = Tb_Stat_Mois
     End With

End Sub

Bon courage,
Amicalement
Alain
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
300 889
Messages
1 988 142
Membres
210 083
dernier inscrit
Patrick92290