Bonsoir à vous,
J'ai fais appel à vos talent il y a quelques semaines, et on m'a bien aidé.
j'ai eu une macro qui fonctionne très bien par un membre du site, je ne retrouve pas son nom :-(
je viens de m'apercevoir que dans la macro il zappe le 31 de chaque mois.
j'espère que celui qui m'a aidé lira ce message car il connait le sujet.
le tableau comprend 12 onglets "mois" et un masque qui va chercher les code absences et les affiches.
j'ai cherché et remarqué que dans les onglets mois il ne trouve pas les absences posées le 31, en supprimant la colonne B il trouve les informations du 31 mais plus du Premier jour du mois.
je joints un extrait du tableau et ci dessous la Macro
merci à vous
Sub Collecte(ByVal FCbl As Worksheet)
Dim FSrc As Worksheet, Cel As Range, Déb As Date, Te(), Codes(), Périodes(), DCV As New Dictionary, _
Valide As Boolean, L As Long, J As Long, Jp As Long, CodCou As String, CodSui As String
On Error Resume Next
Set FSrc = ThisWorkbook.Worksheets(FCbl.[AD4].Value)
If Err Then MsgBox "Feuille """ & FCbl.[AD4].Value & """ introuvable.", vbCritical, "Collecte": Exit Sub
On Error GoTo 0
Te = FCbl.Range("U2:U" & FCbl.[U500].End(xlUp).Row).Value
For L = 1 To UBound(Te)
If Not IsEmpty(Te(L, 1)) Then DCV(UCase(Te(L, 1))) = 0
Next L
Déb = FSrc.[C8].Value - 1
Set Cel = FSrc.[A9:A88].Find(What:=FCbl.[C7].Value, LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Cel Is Nothing Then MsgBox Feuil109.[C7].Value & " inexistant.", vbCritical, "Collecte": Exit Sub
Te = Cel.Offset(, 2).Resize(, 31).Value
ReDim Codes(1 To 19, 1 To 1), Périodes(1 To 19, 1 To 2)
L = 0: J = 1: CodSui = UCase(Te(1, 1))
Do ' Début code
CodCou = CodSui: Valide = DCV.Exists(CodCou)
If Valide Then L = L + 1: Codes(L, 1) = CodCou: Périodes(L, 1) = Format(Déb + J, "dd mmm yyyy")
Do: If J >= 31 Then Exit Do
J = J + 1: CodSui = UCase(Te(1, J)): Loop Until CodSui <> CodCou
' Fin code
If Valide Then Périodes(L, 2) = Format(Déb + J - 1, "dd mmm yyyy")
Loop Until J >= 31
FCbl.[A13].Resize(19, 1).Value = Codes
FCbl.[C13].Resize(19, 2).Value = Périodes
Dim Nom As String, NomFeui As String, FeuiNom As Worksheet
Nom = FCbl.[C7].Value
NomFeui = "Nom " & (Cel.Row - 9) \ 2 + 1
On Error Resume Next
Set FeuiNom = ThisWorkbook.Worksheets(NomFeui)
If Err Then MsgBox "Feuille """ & NomFeui & """ introuvable.", vbCritical, "Collecte": Exit Sub
On Error GoTo 0
If FeuiNom.[B5].Value <> Nom Then MsgBox "Attention, " & NomFeui & "!B5 contient """ & _
FeuiNom.[B5].Value & """ au lieu de """ & Nom & """.", vbExclamation, "Collecte"
FCbl.[G35:R40].Value = FeuiNom.[C40:N45].Value
End Sub
J'ai fais appel à vos talent il y a quelques semaines, et on m'a bien aidé.
j'ai eu une macro qui fonctionne très bien par un membre du site, je ne retrouve pas son nom :-(
je viens de m'apercevoir que dans la macro il zappe le 31 de chaque mois.
j'espère que celui qui m'a aidé lira ce message car il connait le sujet.
le tableau comprend 12 onglets "mois" et un masque qui va chercher les code absences et les affiches.
j'ai cherché et remarqué que dans les onglets mois il ne trouve pas les absences posées le 31, en supprimant la colonne B il trouve les informations du 31 mais plus du Premier jour du mois.
je joints un extrait du tableau et ci dessous la Macro
merci à vous
Sub Collecte(ByVal FCbl As Worksheet)
Dim FSrc As Worksheet, Cel As Range, Déb As Date, Te(), Codes(), Périodes(), DCV As New Dictionary, _
Valide As Boolean, L As Long, J As Long, Jp As Long, CodCou As String, CodSui As String
On Error Resume Next
Set FSrc = ThisWorkbook.Worksheets(FCbl.[AD4].Value)
If Err Then MsgBox "Feuille """ & FCbl.[AD4].Value & """ introuvable.", vbCritical, "Collecte": Exit Sub
On Error GoTo 0
Te = FCbl.Range("U2:U" & FCbl.[U500].End(xlUp).Row).Value
For L = 1 To UBound(Te)
If Not IsEmpty(Te(L, 1)) Then DCV(UCase(Te(L, 1))) = 0
Next L
Déb = FSrc.[C8].Value - 1
Set Cel = FSrc.[A9:A88].Find(What:=FCbl.[C7].Value, LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Cel Is Nothing Then MsgBox Feuil109.[C7].Value & " inexistant.", vbCritical, "Collecte": Exit Sub
Te = Cel.Offset(, 2).Resize(, 31).Value
ReDim Codes(1 To 19, 1 To 1), Périodes(1 To 19, 1 To 2)
L = 0: J = 1: CodSui = UCase(Te(1, 1))
Do ' Début code
CodCou = CodSui: Valide = DCV.Exists(CodCou)
If Valide Then L = L + 1: Codes(L, 1) = CodCou: Périodes(L, 1) = Format(Déb + J, "dd mmm yyyy")
Do: If J >= 31 Then Exit Do
J = J + 1: CodSui = UCase(Te(1, J)): Loop Until CodSui <> CodCou
' Fin code
If Valide Then Périodes(L, 2) = Format(Déb + J - 1, "dd mmm yyyy")
Loop Until J >= 31
FCbl.[A13].Resize(19, 1).Value = Codes
FCbl.[C13].Resize(19, 2).Value = Périodes
Dim Nom As String, NomFeui As String, FeuiNom As Worksheet
Nom = FCbl.[C7].Value
NomFeui = "Nom " & (Cel.Row - 9) \ 2 + 1
On Error Resume Next
Set FeuiNom = ThisWorkbook.Worksheets(NomFeui)
If Err Then MsgBox "Feuille """ & NomFeui & """ introuvable.", vbCritical, "Collecte": Exit Sub
On Error GoTo 0
If FeuiNom.[B5].Value <> Nom Then MsgBox "Attention, " & NomFeui & "!B5 contient """ & _
FeuiNom.[B5].Value & """ au lieu de """ & Nom & """.", vbExclamation, "Collecte"
FCbl.[G35:R40].Value = FeuiNom.[C40:N45].Value
End Sub
