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

Microsoft 365 Absences dans Planning

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

eric72

XLDnaute Accro
décidemment tu ne veux vraiment pas me dire ce qui ne va pas, dommage!
 

TooFatBoy

XLDnaute Barbatruc
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
 

eric72

XLDnaute Accro
Bonjour,
En effet c'est mieux, je prends, en fait tu attendais que je me débrouille et après tu apportes la solution!!!
Merci beaucoup encore une fois (on est pas a l'abri que j'ai encore besoin de ton aide dans les jours à venir)
Bonne journée
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…