Private Sub ComboBox1_GotFocus()
Dim c As Range, a$(), n
[C7] = "=" & [C7].Value2
For Each c In [7:7].SpecialCells(xlCellTypeFormulas, 1)
If Weekday(c) = 2 Then
n = n + 1
ReDim Preserve a(1 To n)
a(n) = Format(c, "dd/mm/yyyy")
End If
Next
[C7] = [C7]
ComboBox1.List = a
ComboBox1.DropDown
End Sub
Private Sub ComboBox1_Change()
If ComboBox1.ListIndex = -1 Then Exit Sub
Application.Goto Cells(1, Application.Match(CDbl(CDate(ComboBox1)), [7:7], 0)), True
[B2].Select
End Sub
=SI(A12="";"";SIERREUR(NB.SI(DECALER(A12;;EQUIV(CUJ$8;$7:$7)-1):DECALER(A12;;EQUIV(CUK$8;$7:$7)-1;;11);"A");""))
=SIERREUR(SOMMEPROD((DECALER(A12;;EQUIV(CUJ$8;$7:$7)-1):DECALER(A12;;EQUIV(CUK$8;$7:$7)-1;;11)="A")*ESTERR(TROUVE("µ";DECALER(A$11;;EQUIV(CUJ$8;$7:$7)-1):DECALER(A$11;;EQUIV(CUK$8;$7:$7)-1;;11))))/SIGNE(A12);"")
Private Sub Worksheet_Change(ByVal Target As Range)
If ListObjects.Count = 0 Then Exit Sub
Dim br As Range, i&
Set br = ListObjects(1).DataBodyRange
If Intersect(Target, br.Columns(2)) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
For i = br.Rows.Count To 2 Step -1
If br(i, 2) = "" Then br.Rows(i).Delete
Next
br.Sort br(1, 2), xlAscending, Header:=xlYes 'tri alphabétique
Application.EnableEvents = True
End Sub
=SIERREUR(SOMMEPROD((DECALER(A$11;LIGNES(CUJ$12:CUJ12);EQUIV(CUJ$8;$7:$7)-1):DECALER(A$11;LIGNES(CUJ$12:CUJ12);EQUIV(CUK$8;$7:$7)-1;;11)="A")*ESTERR(TROUVE("µ";DECALER(A$11;;EQUIV(CUJ$8;$7:$7)-1):DECALER(A$11;;EQUIV(CUK$8;$7:$7)-1;;11))))/SIGNE(DECALER(A$11;LIGNES(CUJ$12:CUJ12);));"")
Private Sub ComboBox1_Change()
If ComboBox1.ListIndex = -1 Then Exit Sub
Dim col%
col = Application.Match(CDbl(CDate(ComboBox1)), [10:10])
[Date_debut] = Cells(10, col)
[Date_fin] = Cells(10, col + 48)
Application.Goto Cells(1, col), True
[B2].Select
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Row <> 11 Then Exit Sub
Cancel = True
Application.Goto Cells(1, [Date_debut].Column - 1), True
[B2].Select
End Sub
Private Sub CommandButton1_Click() 'Création du fichier PDF
If UBound(Split([Eleve])) < 4 Then Exit Sub
Dim chemin$, fichier$
chemin = ThisWorkbook.Path & "\Heures d'absence PDF\" '"D:\Mes documents\GEST-NOTES\Heures d'absence PDF\" 'à adapter
fichier = Split([Eleve])(4) & Format(Date, " yyyy-mm-dd")
If Dir(chemin, vbDirectory) = "" Then MkDir chemin 'création du sous-dossier
If FilterMode Then ShowAllData 'si la feuille est filtrée
[Eleve].Resize(1 + 2 * Application.CountA([Eleve].Resize(1000)), 11).ExportAsFixedFormat xlTypePDF, chemin & fichier
MsgBox "Le fichier '" & fichier & ".pdf' a été créé..."
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim c As Range, deb As Range, col1%, col2%, lig%, i%, n As Byte, j%, col%
'---cadrage des résultats---
If Target.Row = 11 Then
Cancel = True
Application.Goto Cells(1, [Date_debut].Column - 1), True
[B2].Select
Exit Sub
End If
'---relevé des heures d'absence >0 d'un élève---
Set c = Intersect(Target, [Date_debut].Offset(4).Resize(1000)) 'compte tenu de la position de Date_debut
If Not c Is Nothing Then
Cancel = True
Application.ScreenUpdating = False
[Eleve] = "" 'RAZ de la cellule nommée
Set deb = [Eleve].Offset(3)
deb.Resize(1000, 11).UnMerge 'RAZ
deb.Resize(1000, 11).ClearContents 'RAZ
If Val(c) Then
[Eleve] = "Heures d'absence de l'élève " & Cells(c.Row, 2) & " (" & c & ")" 'titre
col1 = Application.Match([Date_debut].Value2, [10:10])
col2 = Application.Match([Date_fin].Value2, [10:10])
lig = -1
For i = col1 To col2 Step 12
n = 0
For j = i To i + 10
If UCase(Cells(c.Row, j)) = "A" And InStr(Cells(14, j), "µ") = 0 Then
n = n + 1
If n = 1 Then
lig = lig + 2
deb(lig, 1).Resize(2).Merge 'fusionne
deb(lig, 1) = Cells(11, i) 'copie la date de la ligne 11
col = 2
End If
deb(lig, col).Resize(2).Merge 'fusionne
deb(lig, col) = Cells(12, j) 'copie les heures de la ligne 12
col = col + 1
End If
Next j, i
End If
End If
End Sub