Deboguage macro

Le 07/04/2023 à 12:37

Bonjour à toutes et à tous !

J'ai un pb avec ma macro, que je ne parviens pas à déboguer...Mon fichier étant trop lourd pour être envoyé, voici un visu de l'outil, un résumé et le code ci-dessous... Pouvez-vous m'aider à comprendre quel est le problème ?

Sur l'onglet "2023" (ci-contre) : mon salarié sélectionne un intitulé d'absence (Exemple : "T" = télétravail), dans la ligne correspondant à son nom et la demi-journée souhaitée (AM ou PM) et la colonne correspondant à la date du jour souhaité.

image

Après cela, lorsqu'un cadre, par exemple, change la date dans la cellule B4 (date du jour) dans l'onglet "Calendrier final" (ci-contre), alors les données s'incrémentent à partir du tableau 2023 dans la ligne correspondant à l'agent/demi-journée et les colonnes contentant les jours du mois B4 (de 1 au dernier jour du mois).

image

Voici les codes utilisés

'Feuille 2023 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Mois As String
Mois = Sheets("2023").Range("$G$4").Value

  'mois sur la feuille "2023
 If Target.Adresse <> "G4" Then Exit Sub

  'plage des dates en ligne
 Range("H5:NH5").EntireColumn.Hidden = False

 If Target.Value = "" Then Exit Sub

Dim madate As Date, coldeb As Integer

   'la date = 1er jour du mois + moiscellule + anneecellule

  madate = DateValue("1 " & Range("G4").Value & " " & Range("G2").Value)

  'colonne de début croisement entre la 6è ligne et la cellule contenant la premièredate du mois.

  coldeb = 6 + madate - Range("H5").Value

  If coldeb > 6 Then Range(Range("H5"), Cells(, coldeb)).EntireColumn.Hidden = True

End Sub
Feuille Calendrier final : 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Application.Intersect(Target, Range("B4")) Is Nothing Then Exit Sub
        'Si Date du jour ne change pas on quitte la procedure

    Dim Col_Jour1, L_Agent, J_Agent As Integer  'Colonne jour 1 / Ligne Agent / Jour Agent
    Dim L_Agent_Inconnu As Long     'Ligne pour l'agent non connu
    Dim C_Agent As Range            'Cellule Agent
    Dim Jour1Mois As Date           '1er jour du mois
    Dim C_Periode As String         'Cellule AM ou PM

        'On efface les données précédentes

    Range("K7:AO132").ClearContents
    Jour1Mois = DateValue("1 " & Range("B3").Value & " " & Range("B2").Value) 'jour1mois = 1er jour du mois + moiscellule + anneecellule

With Sheets("2023")

    'si anneecellule2023 ne contient pas anneecellulecalednrier alors
    If .Range("G2").Value <> Range("B2").Value Then
            MsgBox ("La feuille " & Range("B2").Value & " n'existe pas") 'message box
        Exit Sub 'on sort de la boucle
    End If 'et si

      'Col_Jour1 = croisement entre la 7ème ligne de la colonne contenant la première date du mois.Value
    Col_Jour1 = 7 + Jour1Mois - .Range("H5").Value

         'Boucle sur Agent pour chaque ligne agent
    For L_Agent = 6 To .Range("G" & Rows.Count).End(xlUp).Row

        For J_Agent = Col_Jour1 To Col_Jour1 + 31                 'Boucle sur mois en cours
            If .Cells(L_Agent, J_Agent).Value <> "" Then           'si la cellule jour agent et ligne agent ne correspondent pas alors

IncriptionInconnu:  'Point retour pour les jour de l'agent non connu

                Set C_Agent = Columns(8).Find(.Cells(L_Agent, 6).Value, LookIn:=xlValues)             'plage agent en colonne n°8/G

                  'localisation de la plage période dans la feuille "2023"
                C_Periode = .Cells(L_Agent, 6).Value

                'C_Agent = la cellule Agent dans Calendrier final correspondant a la ligne "i" du 2023

                If Not C_Agent Is Nothing Then  'si l'agent est trouvé

                    '11 = première colonne où rentrer les dates (correspondant à Jour1)
                    If C_Periode = "AM" Then Cells(C_Agent.Row, 11 + J_Agent - Col_Jour1).Value = .Cells(L_Agent, J_Agent).Value
                    If C_Periode = "PM" Then Cells(C_Agent.Row + 1, 11 + J_Agent - Col_Jour1).Value = .Cells(L_Agent, J_Agent).Value

                Else    'sinon on le liste dans le calendrier

                          'Agent non inscrit sur calendrier final -> A creer sous le tableau
                    L_Agent_Inconnu = Range("H" & Rows.Count).End(xlUp).Row + 3

                                    'Pour la ligne AM :

                    Range("A" & L_Agent_Inconnu).Value = .Range("A" & L_Agent).Value    'Etage
                    Range("B" & L_Agent_Inconnu).Value = .Range("B" & L_Agent).Value    'Pole
                    Range("C" & L_Agent_Inconnu).Value = .Range("C" & L_Agent).Value    'Responsable
                    Range("D" & L_Agent_Inconnu).Value = .Range("D" & L_Agent).Value      'Poste
                    'Range("F" & L_Agent_Inconnu).Value=.Range("E" &L_Agent).Value          'Bureau
                    'Range("H" & L_Agent_Inconnu).Value=.Range("G" & L_Agent,7).Value       'Agent =.Cells(L_Agent,7)-> 7 = numéro colonne
                    'Range("I" & L_Agent_Inconnu).Value=.Range("F" & L_Agent,6).Value       'Période = 6 = numéro colonne

                                        'On passe sur la ligne PM :

                    Range("A" & L_Agent_Inconnu + 1).Value = .Range("A" & L_Agent + 1).Value 'Etage
                    Range("B" & L_Agent_Inconnu + 1).Value = .Range("B" & L_Agent + 1).Value    'Pole
                    Range("C" & L_Agent_Inconnu + 1).Value = .Range("C" & L_Agent + 1).Value     'Responsable
                    Range("D" & L_Agent_Inconnu + 1).Value = .Range("D" & L_Agent + 1).Value    'Poste
                    Range("F" & L_Agent_Inconnu + 1).Value = .Range("E" & L_Agent + 1).Value    'Bureau
                    Range("H" & L_Agent_Inconnu + 1).Value = .Cells(L_Agent + 1, 7).Value   'Agent
                    Range("I" & L_Agent_Inconnu + 1).Value = .Cells(L_Agent + 1, 6).Value   'Période

                    GoTo IncriptionInconnu  'L'agent est en liste on retrouner plus  haut dans la procedure pour identifier les jours J_Agent
                End If
            End If
        Next J_Agent
    Next L_Agent
End With
End Sub

Je vous remercie par avance pour vos indications et vos explications.. Une excellente journée à tous

Je peux éventuellement envoyer mon fichier par mail ou wetransfert si besoin...

jade

Le 07/04/2023 à 12:40

bonjour,

sans avoir regardé le reste, ceci ne me parait pas correct

 'mois sur la feuille "2023
 If Target.Adresse <> "G4" Then Exit Sub

cela devrait être

 'mois sur la feuille "2023
 If Target.Address <> "$G$4" Then Exit Sub

Pour le reste ce que tu as envoyé ne permet pas de comprendre le problème (en tout cas pour ce qui me concerne), pas de message d'erreur, pas d'indication a propos de ce qui ne fonctionne pas, pas d'indication du résultat attendu, ...

Le 07/04/2023 à 14:28
Private Sub Worksheet_Change(ByVal Target As Range)

Dim Mois As String
Mois = Range("$G$4").Value

  'mois sur la feuille "2023
 If Target.Address <> "$G$4" Then Exit Sub

   'plage des dates en ligne
 Range("H5:NH5").EntireColumn.Hidden = False

 If Target.Value = "" Then Exit Sub

Dim madate As Date, coldeb As Integer

   'la date = 1er jour du mois + moiscellule + anneecellule

  madate = DateValue("1 " & Range("G4").Value & " " & Range("G2").Value)

  'colonne de début croisement entre la 6è ligne et la cellule contenant la premièredate du mois.

  coldeb = 6 + madate - Range("H5").Value

  If coldeb > 6 Then Range(Range("H5"), Cells(, coldeb)).EntireColumn.Hidden = True

End Sub

Merci h2so4 pour ton retour,

Effectivement, ça fonctionne mieux !

J'ai trouvé un deuxième problème mais je ne sais pas quelle partie de ma macro modifier :

en plage H5:NH5, mes dates du 01/01/$G$2 au 31/12/$G$2.

En sélectionnant un mois dans ma cellule $G$4, les colonnes dont le mois précèdent $G$4 sont cachées : Exemple, si je sélectionne Février, alors la plage de Janvier est cachée avec la fonction Hidden et la première colonne visible affiche 1er Février (année$G$4).

Actuellement, quand je sélectionne Février, j'ai le 31 janvier qui s'affiche, pareil pour les autres mois, qui affichent le dernier jour du mois précédent...

Comment puis-je modifier ça ?

Merci par avance,

Jade

Le 07/04/2023 à 14:46

bonjour,

selon moi, le problème se situe ici

coldeb = 6 + madate - Range("H5").Value

  If coldeb > 6 Then Range(Range("H5"), Cells(, coldeb)).EntireColumn.Hidden = True

d'après ce que tu dis, j'en conclus que cela devrait être ceci

coldeb = 7 + madate - Range("H5").Value

  If coldeb > 7 Then Range(Range("H5"), Cells(, coldeb)).EntireColumn.Hidden = True

Mais on est dans l'art divinatoire, ce qui n'est pas ma spécialité.

Rechercher des sujets similaires à "deboguage macro"