Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 Absences dans Planning

E

eric72

XLDnaute Accro
Bonjour à tous,
Je suis toujours avec mon Planning, ça avance bien mais je rencontre de nouveau un problème, je m'explique:
- Onglet Planning, quand je sélectionne une semaine d'une année, je récupère bien tous les plannings de chacun, en parallèle j'ai un tableau qui s'appelle TbCauseAbs que je remplis pour inscrire les congés, les maladie etc...
- J'aimerais dans mon "Planning" que lorsqu'un collaborateur apparait dans le planning, si une absence est renseignée pour cette date que cela s'incrive dans les colonnes correspondantes à savoir pour le lundi (d:g) pour le mardi (l) etc...
- J'ai débuté une macro (module1) avec "test" et "NoterAbsence" mais cela ne correspond pas.
- J'ai trouvé une idée qui ne fonctionne pas pleinement:
VB: 
Sub test()
Dim NomEquipier As Integer, RangDuJour As Integer, c As Range, madate As Long

Set c = Sheets("Données").Range("TbAbsence").Find(what:=Sheets("Planning").Range("e4").Value, lookat:=xlWhole)
If Not c Is Nothing Then

madate = Sheets("Planning").Range("e4").Value
Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    For NomEquipier = 1 To 20
            For RangDuJour = 1 To 6
                NoterAbsence NomEquipier, RangDuJour
            Next RangDuJour
    Next NomEquipier
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End If
End Sub
Sub NoterAbsence(NomEquipier As Integer, RangDuJour As Integer)
Dim LigCible As Long, ColCible As Long, madate As Long, datejourL As String, datejourM As String, datejourMe As String, datejourJ As String, datejourV As String, datejourS As String
Dim OffsetLig As Long, OffsetCol As Long, c As Range, c2 As Range

With Sheets("Planning")

    madate = Sheets("Planning").Range("e4").Value
    OffsetLig = 1 * (NomEquipier - 1)
    OffsetCol = 8 * (RangDuJour - 1)
        If RangDuJour = 1 Then 'Récupérer LUNDI
            datejourL = Sheets("Planning").Range("d5")
                .Cells(8 + OffsetLig, 4 + OffsetCol).Value = "IFERROR(INDEX(TbAbsence[#All],MATCH(1,(datejourL>=TbAbsence[[#All],[Date début]])*(TbAbsence[[#All],[Date fin]]>=datejourL)*(TbAbsence[[#All],[Nom]]=8 + OffsetLig, 2 + OffsetCol).Value,"""")"
    End If
End With
End Sub

Avez-vous une petite idée?
Merci beaucoup une nouvelle fois
 

Pièces jointes

  • test.xlsm
    343.2 KB · Affichages: 13
Solution
Re

La macro de #13 doit aussi pouvoir s'écrire comme ceci (pour éviter la boucle FOR qui doit être plus lente) :
VB: 
Sub Archive_Absence()
'
Dim LigCible As Long, ColCible As Long, MaDateDebut As Long, MaDateFin As Long

    Application.ScreenUpdating = False

    MaDateDebut = CDate(UsfAjoutAbsence.TxtDebut)
    MaDateFin = CDate(UsfAjoutAbsence.TxtFin)

    LigCible = Application.Match(UsfAjoutAbsence.CbNom, Sheets("Archives").Range("C:C"), 0)
    ColCible = Application.Match(MaDateDebut, Sheets("Archives").Range("2:2"), 0)

    Sheets("Archives").Cells(LigCible + 1, ColCible).Resize(1, MaDateFin - MaDateDebut + 1).Value = UsfAjoutAbsence.CbCause

End Sub
Trier par date Trier par votes
E

eric72

XLDnaute Accro
Je progresse mais j'ai toujours une erreur sur:
VB: 
Sub test()
Dim NomEquipier As Integer, RangDuJour As Integer, c As Range, madate As Long

Set c = Sheets("Données").Range("TbAbsence").Find(what:=Sheets("Planning").Range("e4").Value, lookat:=xlWhole)
If Not c Is Nothing Then

madate = Sheets("Planning").Range("e4").Value
Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    For NomEquipier = 1 To 20
            For RangDuJour = 1 To 6
                NoterAbsence NomEquipier, RangDuJour
            Next RangDuJour
    Next NomEquipier
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End If
End Sub
Sub NoterAbsence(NomEquipier As Integer, RangDuJour As Integer)
Dim LigCible As Long, ColCible As Long, madate As Long, datejourL As String, datejourM As String, datejourMe As String, datejourJ As String, datejourV As String, datejourS As String
Dim OffsetLig As Long, OffsetCol As Long, c As Range, c2 As Range

With Sheets("Planning")

    madate = Sheets("Planning").Range("e4").Value
    OffsetLig = 1 * (NomEquipier - 1)
    OffsetCol = 8 * (RangDuJour - 1)
    
        If RangDuJour = 1 Then 'Récupérer LUNDI
            datejourL = Sheets("Planning").Range("d5")
                   .Cells(8 + OffsetLig, 4 + OffsetCol).Value = Application.Index("TbAbsence[#All]", Application.Match(1, (CDate(datejourL) >= "TbAbsence[Date début]") * ("TbAbsence[Date fin]" >= CDate(datejourL)) * ("TbAbsence[[#All],[Nom]]" = .Cells(8 + OffsetLig, 2 + OffsetCol).Value), 0), 2)
        End If
        
                If RangDuJour = 2 Then 'Récupérer MARDI
            datejourM = Sheets("Planning").Range("L5")
                   .Cells(8 + OffsetLig, 4 + OffsetCol).Value = Application.Index("TbAbsence[#All]", Application.Match(1, (CDate(datejourM) >= "TbAbsence[Date début]") * ("TbAbsence[Date fin]" >= CDate(datejourM)) * ("TbAbsence[[#All],[Nom]]" = .Cells(8 + OffsetLig, 2 + OffsetCol).Value), 0), 2)
                                                    
       End If

End With
End Sub
avec une erreur 13 d'incompatibilité
ici:
Code: 
 .Cells(8 + OffsetLig, 4 + OffsetCol).Value = Application.Index("TbAbsence[#All]", Application.Match(1, (CDate(datejourL) >= "TbAbsence[Date début]") * ("TbAbsence[Date fin]" >= CDate(datejourL)) * ("TbAbsence[[#All],[Nom]]" = .Cells(8 + OffsetLig, 2 + OffsetCol).Value), 0), 2)
Je ne comprends pas bien pourquoi!!!
Merci
 
Vote positif 0 Vote négatif

ChTi160

XLDnaute Barbatruc
Re
Dans cette Procédure , j'ai modifié deux Choses Lol
VB: 
Sub test()
Dim NomEquipier As Integer, RangDuJour As Integer, c As Range, madate As Date 'Variable madate declarée en Date plutôt que Long
madate = Sheets("Planning").Range("e4").Value 'déplacé ici
Set c = Sheets("Données").Range("TbAbsence").Find(what:=madate, lookat:=xlWhole) 'Mise en Place de la Variable
If Not c Is Nothing Then
'madate = Sheets("Planning").Range("e4").Value 'déplacé plus haut
Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    For NomEquipier = 1 To 20
            For RangDuJour = 1 To 6
                NoterAbsence NomEquipier, RangDuJour
            Next RangDuJour
    Next NomEquipier
    Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End If
End Sub
Ça ne résout pas tout Lol
je continue Lol
Jean marie
 
Vote positif 0 Vote négatif
E

eric72

XLDnaute Accro
Bonjour Jean-Marie,
J'avance tout doucement, j'ai modifié un peu la méthode en mettant les noms en debut de ligne , ca sera surement plus pratique, mais je n'arrive pas à partir de mon userform UsfAjoutAbsence, lors de la validation à inscrire dans "Archives" aux dates comprises entre Date de début et Date de fin, la cause de l'absence, juste en dessous des "Semaines", peut-être une petite idée?
Merci et bonne soirée
Eric
 
Vote positif 0 Vote négatif
E

eric72

XLDnaute Accro
j'ai oublié le fichier, oups!!!
 

Pièces jointes

  • testexceldownload.xlsm
    211 KB · Affichages: 8
Vote positif 0 Vote négatif

TooFatBoy

XLDnaute Barbatruc
eric72 à dit:
Tu as bien raison d'en rire
Cliquez pour agrandir...
Je précise que ce n'est pas un ricanement moqueur ou sarcastique.
C'est juste une "private joke" entre nous, genre "Tiens donc, mais d'où te vient cette idée ?".


eric72 à dit:
par contre je ne parviens pas a partir de mon userform a transferer les absences a partir du nom et de la date de debut et fin, donc je ne suis pas beaucoup plus avancé!!!
Cliquez pour agrandir...
T'inquiète, ça va venir. Tu vas trouver, avec ou sans aide.

Je n'ai pas le temps cette semaine, et j'avoue que j'ai décroché et ne sais pas où tu en es exactement.
 
Vote positif 0 Vote négatif

TooFatBoy

XLDnaute Barbatruc
Une petite macro pour te proposer une idée pour trouver le nom sélectionné dans ta ComboBox :
VB: 
Private Sub CbNom_Change()
'
    NomCherche = CbNom.Value
    With Sheets("Archives")
        Set a = .Range("C3:C42").Find(What:=NomCherche, LookIn:=xlValues)
        If a Is Nothing Then
            b = .Range("C1").End(xlDown).Row + 1
            If b > 43 Then
                MaRep = MsgBox(NomCherche & " non trouvé et" & vbCrLf & "le tableau est complet.", vbInformation, "Non trouvé")
            Else
                MaRep = MsgBox(NomCherche & " non trouvé." & vbCrLf & "Prochaine ligne vide : ligne n° " & b, vbInformation, "Non trouvé")
            End If
        Else
            MaRep = MsgBox(NomCherche & " trouvé" & vbCrLf & "sur la ligne n° " & a.Row, vbInformation, "Non trouvé")
        End If
    End With

End Sub

Remarque : il ne faut pas de "trous" (cellule vide) dans la colonne C pour la recherche de la première ligne vide, donc j'ai mis une croix sous chaque nom.


eric72 à dit:
par contre je ne parviens pas a partir de mon userform a transferer les absences a partir du nom et de la date de debut et fin
Cliquez pour agrandir...
Une fois que t'as pigé pour trouver le nom (ce qui te donne la ligne), tu fais pareil pour trouver la date (ce qui te donnera la colonne).
Une fois que tu as la ligne et la colonne, y a pu qu'à lire ou écrire dans la cellule, ou dans celle du dessous (par exemple avec un offset d'une ligne et zéro colonne).
 

Pièces jointes

  • 05-testexceldownload.xlsm
    207.4 KB · Affichages: 5
Dernière édition:
Vote positif 0 Vote négatif
E

eric72

XLDnaute Accro
Mais ca n'est pas le nom qui me pose un problème, c'est plutôt pour reporter l'absence de la date de début à la date de fin, et là ça se complique pour moi. pour la ligne c'est ok, c'est les colonnes qui m'ennuient
 
Vote positif 0 Vote négatif
E

eric72

XLDnaute Accro
Je remets le fichier avec la fonction calendrier pour tester et j'explique l'idée:
- dans mon userform j'entre date de début et date de fin
- lorsque je valide ma saisie j'aimerais que la cause de l'absence, exemple "Maladie" viennent se mettre à la ligne qui correspond au nom et dans chaque colonne comprise entre date de début et date de fin dans "Archives", ça fait deux jours que je patine et je ne trouve aucun exemple à ce sujet.
Je désespère!!!
Merciiiiiii
 

Pièces jointes

  • 05-testexceldownload.xlsm
    227.7 KB · Affichages: 8
Vote positif 0 Vote négatif
E

eric72

XLDnaute Accro
Eureka!!!
Après 2 jours de galère, je pense avoir trouvé la solution avec cette macro (pour ceux que cela pourrait intéresser:
VB: 
Sub Archive_Absence()

Dim LigCible As Long, ColCible As Long, madatedebut As Long, madatefin As Long, cel As Range

    Application.ScreenUpdating = False
    madatedebut = CDate(UsfAjoutAbsence.TxtDebut)
    madatefin = CDate(UsfAjoutAbsence.TxtFin)
    LigCible = Application.Match(UsfAjoutAbsence.CbNom, Sheets("Archives").Range("c:c"), 0)
    ColCible = Application.Match(madatedebut, Sheets("Archives").Range("2:2"), 0)
    
        Sheets("Archives").Cells(LigCible + 1, ColCible).Value = UsfAjoutAbsence.CbCause
        
        Set cel = Sheets("Archives").Cells(LigCible + 1, ColCible)
        
        nb_copie = DateDiff("d", madatedebut, madatefin)
        
        Set plage = cel.Offset(0, 0).Resize(1, 1)
        For I = 1 To nb_copie
            If Not cel Is Nothing Then
            cel.Copy plage.Offset(0, plage.Columns.Count * I)
            Cells(1, plage.Columns.Count * 2 + 1).Value = Cells(1, plage.Columns.Count)
            End If
        Next I

End Sub

Avec la fonction Datediff
Merci et bonne journée à tous.
 
Vote positif 0 Vote négatif

TooFatBoy

XLDnaute Barbatruc
eric72 à dit:
Mais ca n'est pas le nom qui me pose un problème, c'est plutôt pour reporter l'absence de la date de début à la date de fin
Cliquez pour agrandir...
Comme je l'ai dit plus haut, tu peux procéder par une recherche de la date (de début) de la même façon que la recherche du nom.
Une fois que tu as l'adresse (ligne et colonne) de la cellule de départ, tu n'as plus qu'à écrire dedans et dans les suivantes avec une boucle.
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
360
Chaton77
  • Question
Autres fenêtre "Publication"
Réponses
10
Affichages
375
ph.vanne
  • Question
XL 2016 Protéger Plage avec condition
2
Réponses
16
Affichages
862
Amigo
J
  • Question
Microsoft 365 Code VBA
Réponses
10
Affichages
714
jebibo
J
G
  • Question
Microsoft 365 Export données
Réponses
4
Affichages
426
GClaire
G
E
  • Résolu(e)
Microsoft 365 Ajout et Suppression Date automatique
Réponses
9
Affichages
400
eric72
E
S
  • Résolu(e)
Microsoft 365 Ecrasement d'une ligne si déjà existante
Réponses
2
Affichages
117
sebastien176
S
  • Question
Autres la fonction similaire
Réponses
11
Affichages
357
patricktoulon
E
  • Question
XL 2013 Code VBA
Réponses
12
Affichages
819
eutrophisation
E
  • Question
XL 2021 Code manufacturier et fabricant (Ram) suite projet en cours ( à tester s'il vous plait )
2 3
Réponses
42
Affichages
974
TooFatBoy
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…