Bonjour à toutes & à tous, bonjour @Seddiki_adz
Voilà ce que j'ai fait : Je suis resté sur la feuille Récap telle qu'elle était. et j'ai procédé par sélection par Nom du prof, mois, semaine, jour de semaine avec formules et formats conditionnels pour aider à la sélection et gestion de l'événement Worksheet_Change de la feuille Récap.
Des messages d'avertissement suivant la situation peuvent s'afficher ligne 12.
Cellules ou noms définis impliqués :
N'ayant pas d'imprimante, je vous ai fait un code avec juste un aperçu avant impression au lieu d'une impression réelle. Il faudra bien sûr remplacer l'instruction "d'aperçu" par une instruction "Imprimer".
Code dans module1:
VB:
Sub ImprimerMois()
Dim xm, ListSep, xrg As Range
With Sheets("tot")
If .FilterMode Then .ShowAllData
Set xrg = .Range("a4").CurrentRegion.Cells(.Range("a4").CurrentRegion.Count)
Set xrg = .Range(.Range("a2"), xrg)
For Each xm In Split(.Range("c2").Validation.Formula1, Application.International(xlListSeparator))
Range("c2") = xm
xrg.PrintPreview
Next xm
End With
End Sub
N'ayant pas d'imprimante, je vous ai fait un code avec juste un aperçu avant impression au lieu d'une impression réelle. Il faudra bien sûr remplacer l'instruction "d'aperçu" par une instruction "Imprimer".
Code dans module1:
VB:
Sub ImprimerMois()
Dim xm, ListSep, xrg As Range
With Sheets("tot")
If .FilterMode Then .ShowAllData
Set xrg = .Range("a4").CurrentRegion.Cells(.Range("a4").CurrentRegion.Count)
Set xrg = .Range(.Range("a2"), xrg)
For Each xm In Split(.Range("c2").Validation.Formula1, Application.International(xlListSeparator))
Range("c2") = xm
xrg.PrintPreview
Next xm
End With
End Sub
Comme d'habitude j'arrive un peu tard et bien que ma proposition soit caduque je la fait quand même :
J'ai repris le classeur que je t'avais fait pour le fil Code de Transfert et je l'ai adapté à tes nouveaux besoins (Feuille Totaux avec impression par mois -cf la solution de mapomme-, et feuille Absences)
J'ai étendu le projet à tous les jours de la semaine, mais il peut être facilement réduit du dimanche au jeudi.
Ce projet utilise les tableaux structurés (ListObject en VBA) :
Nom du tableau
Objet
Feuille
Planning
tableau de la feuille Planning
sept
tableau de la feuille sept
oct
tableau de la feuille oct
nov
tableau de la feuille nov
déc
tableau de la feuille déc
janv
tableau de la feuille janv
févr
tableau de la feuille févr
mars
tableau de la feuille mars
avr
tableau de la feuille avr
mai
tableau de la feuille mai
juin
tableau de la feuille juin
Récap
tableau de la feuille Récap
Totaux
tableau de la feuille Totaux
Absences
tableau de la feuille Absences
_tb_Profs
table des profs
Feuille Tables
_tb_Jours
table des jours
Feuille Tables
_tb_Semaines
table des semaines
Feuille Tables
_tb_Horaires
table des horaires
Feuille Tables
_tb_Mois
table des mois
Feuille Tables
_tb_Classes
table des classes
Feuille Tables
Quelques noms définis utilisés pour les validations de cellules et pour faciliter la saisie des formules :
La macro d'impression pour tous les mois s'inspire de celle de mapomme : avec une adaptation au tableau structuré et aux noms définis utilisés :
Enrichi (BBcode):
Sub ImprimerTotaux()
Dim Z_Imp As Range, RgMois As Range, ChxMois
With F14_Totaux
Set Z_Imp = .Range(.[Mois], .[_tb_Total].ListObject.Range)
Set RgMois = .[Mois]
With .[_tb_Total].ListObject.AutoFilter
If .FilterMode Then
If MsgBox("Effacer les filtres ?", vbYesNo) = vbYes Then .ShowAllData
End If
End With
End With
ChxMois = [chx_Mois].Value
For Each Mois In ChxMois
RgMois = Mois
Z_Imp.PrintOut
Next
End Sub
Voilà
Regarde le fichier joint
Amicalement
Alain MODIF 1 : Nom du tableau Absences et émoticône :D
MODIF 2 : Correction Bug nom du tableau Totaux
Comme d'habitude j'arrive un peu tard et bien que ma proposition soit caduque je la fait quand même :
J'ai repris le classeur que je t'avais fait pour le fil Code de Transfert et je l'ai adapté à tes nouveaux besoins (Feuille Totaux avec impression par mois -cf la solution de mapomme-, et feuille Absences)
J'ai étendu le projet à tous les jours de la semaine, mais il peut être facilement réduit du dimanche au jeudi.
Ce projet utilise les tableaux structurés (ListObject en VBA) :
Nom du tableau
Objet
Feuille
Planning
tableau de la feuille Planning
sept
tableau de la feuille sept
oct
tableau de la feuille oct
nov
tableau de la feuille nov
déc
tableau de la feuille déc
janv
tableau de la feuille janv
févr
tableau de la feuille févr
mars
tableau de la feuille mars
avr
tableau de la feuille avr
mai
tableau de la feuille mai
juin
tableau de la feuille juin
Récap
tableau de la feuille Récap
Totaux
tableau de la feuille Totaux
Absences
tableau de la feuille Absences
_tb_Profs
table des profs
Feuille Tables
_tb_Jours
table des jours
Feuille Tables
_tb_Semaines
table des semaines
Feuille Tables
_tb_Horaires
table des horaires
Feuille Tables
_tb_Mois
table des mois
Feuille Tables
_tb_Classes
table des classes
Feuille Tables
Quelques noms définis utilisés pour les validations de cellules et pour faciliter la saisie des formules :
=Absences!D _tb_abscences[#En-têtes] (En colonne D)
La macro d'impression pour tous les mois s'inspire de celle de mapomme : avec une adaptation au tableau structuré et aux noms définis utilisés :
Enrichi (BBcode):
Sub ImprimerTotaux()
Dim Z_Imp As Range, RgMois As Range, ChxMois
With F14_Totaux
Set Z_Imp = .Range(.[Mois], .[_tb_Total].ListObject.Range)
Set RgMois = .[Mois]
With .[_tb_Total].ListObject.AutoFilter
If .FilterMode Then
If MsgBox("Effacer les filtres ?", vbYesNo) = vbYes Then .ShowAllData
End If
End With
End With
ChxMois = [chx_Mois].Value
For Each Mois In ChxMois
RgMois = Mois
Z_Imp.PrintOut
Next
End Sub
Comme d'habitude j'arrive un peu tard et bien que ma proposition soit caduque je la fait quand même :
J'ai repris le classeur que je t'avais fait pour le fil Code de Transfert et je l'ai adapté à tes nouveaux besoins (Feuille Totaux avec impression par mois -cf la solution de mapomme-, et feuille Absences)
J'ai étendu le projet à tous les jours de la semaine, mais il peut être facilement réduit du dimanche au jeudi.
Ce projet utilise les tableaux structurés (ListObject en VBA) :
Nom du tableau
Objet
Feuille
Planning
tableau de la feuille Planning
sept
tableau de la feuille sept
oct
tableau de la feuille oct
nov
tableau de la feuille nov
déc
tableau de la feuille déc
janv
tableau de la feuille janv
févr
tableau de la feuille févr
mars
tableau de la feuille mars
avr
tableau de la feuille avr
mai
tableau de la feuille mai
juin
tableau de la feuille juin
Récap
tableau de la feuille Récap
Totaux
tableau de la feuille Totaux
Absences
tableau de la feuille Absences
_tb_Profs
table des profs
Feuille Tables
_tb_Jours
table des jours
Feuille Tables
_tb_Semaines
table des semaines
Feuille Tables
_tb_Horaires
table des horaires
Feuille Tables
_tb_Mois
table des mois
Feuille Tables
_tb_Classes
table des classes
Feuille Tables
Quelques noms définis utilisés pour les validations de cellules et pour faciliter la saisie des formules :
La macro d'impression pour tous les mois s'inspire de celle de mapomme : avec une adaptation au tableau structuré et aux noms définis utilisés :
Enrichi (BBcode):
Sub ImprimerTotaux()
Dim Z_Imp As Range, RgMois As Range, ChxMois
With F14_Totaux
Set Z_Imp = .Range(.[Mois], .[_tb_Total].ListObject.Range)
Set RgMois = .[Mois]
With .[_tb_Total].ListObject.AutoFilter
If .FilterMode Then
If MsgBox("Effacer les filtres ?", vbYesNo) = vbYes Then .ShowAllData
End If
End With
End With
ChxMois = [chx_Mois].Value
For Each Mois In ChxMois
RgMois = Mois
Z_Imp.PrintOut
Next
End Sub
Voilà
Regarde le fichier joint
Amicalement
Alain MODIF : Nom du tableau Absences et émoticône :D
Bon ça c'est l'attendu, mais à partir de quoi ?
Nom, Prénom, Matière c'est facile il y a la table "_tb_Profs".
Mais le jour, c'est au choix un jour de la semaine (dimanche, lundi, ...) et l'on ramène les classes à partir du planning ?
Merci d'être un peu plus explicite pour que l'on ne travaille pas à l'aveuglette.
Amicalement
Alain
En C11 Nom du Prof : Données, Validation, liste =chx_Profs
En D11 Prénom : formule =INDEX(_tb_Profs[Prénom];EQUIV($C$11;_tb_Profs[Nom];0))
En E11 Matière : formule =INDEX(_tb_Profs[Matière];EQUIV($C$11;_tb_Profs[Nom];0))
A
B
C
D
E
F
18
AM
8-9
9-10
10-11
11-12
12-13
19
20
PM
13-14
14-15
15-16
16-17
21
En B18 Recherche de la classe : formule =SIERREUR(INDEX(Planning[#En-têtes];;EQUIV($C$11;DECALER(Planning[#En-têtes];EQUIV($C$16;Planning[Jour];0)+EQUIV(B18;_tb_Horaires;0)-1;0);0));"")
Copier, Collage spécial, Formules sur les autres cellules de recherche (C19:F19 et B21:E21)
Si en ajoute un colonne de chaque mois la date ( dernier colonne)
Depuis l'onglet recap suivant la colonne date en obtient les donnée de l'onglet justification
si possible ?
et ajout code impression
Bonjour à toutes & à tous, bonjour @Seddiki_adz
Voilà ce que j'ai fait : Je suis resté sur la feuille Récap telle qu'elle était. et j'ai procédé par sélection par Nom du prof, mois, semaine, jour de semaine avec formules et formats conditionnels pour aider à la sélection et gestion de l'événement Worksheet_Change de la feuille Récap.
Des messages d'avertissement suivant la situation peuvent s'afficher ligne 12.
Cellules ou noms définis impliqués :
Formule =SIERREUR(INDEX(_tb_Profs[Prénom];EQUIV($D$7;_tb_Profs[Nom];0));"")
$H$7
Formule =SIERREUR(INDEX(_tb_Profs[Matière];EQUIV($D$7;_tb_Profs[Nom];0));"")
$D$10
Formule =SI((Sél_Prof<>"")*(Sél_Mois="")*(GAUCHE(C12;12)<>"Pas de cours");"mois ?";"")
$E$10
Formule =SI((Sél_Mois<>"")*(Sél_Semaine="")*(GAUCHE(C12;12)<>"Pas de cours");"semaine ?";"")
$F$10
Formule =SI((Sél_Semaine<>"")*(Sél_Jour="")*(GAUCHE(C12;12)<>"Pas de cours");"jour ?";"")
$C$12
Formule
=CHOISIR(NBVAL(Sél_Prof;Sél_Mois;Sél_Semaine;Sél_Jour)+1;
"Séléctionner un professeur";
SI(NB.SI.ENS(Récap[profs];Sél_Prof)=0;"Pas de cours pour le professeur " &Sél_Prof;"");
SI(NB.SI.ENS(Récap[profs];Sél_Prof;Récap[mois];Sél_Mois)=0;"Pas de cours pour le mois de "&Sél_Mois;"");
SI(NB.SI.ENS(Récap[profs];Sél_Prof;Récap[mois];Sél_Mois;Récap[semaine];Sél_Semaine)=0;"Pas de cours"&Sél_Semaine;"");
SI(NB.SI.ENS(Récap[profs];Sél_Prof;Récap[mois];Sél_Mois;Récap[semaine];Sél_Semaine;Récap[jours];Sél_Jour)=0;"Pas de cours "&Sél_Jour;""))
$C$14
Formule =SIERREUR(SI(ESTVIDE(INDEX(INDIRECT("Récap["&C13&"]");Ligne));"";INDEX(INDIRECT("Récap["&C13&"]");Ligne));"")
D14; E14; F14; C16; D16; E16; F16; G16
Recopier la formule de C14
Macro Worksheet_Change :
Enrichi (BBcode):
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
Nom = ""
On Error Resume Next
Nom = Target.Name
On Error GoTo 0
If Nom <> "" Then
With Me
Application.EnableEvents = False
Select Case Target.Address
Case Is = Me.[Sél_Prof].Address
Union(.[Sél_Mois], .[Sél_Semaine], .[Sél_Jour]).ClearContents
Case Is = Me.[Sél_Mois].Address
Union(.[Sél_Semaine], .[Sél_Jour]).ClearContents
Case Is = Me.[Sél_Semaine].Address
.[Sél_Jour].ClearContents
End Select
Application.EnableEvents = True
End With
End If
End If
End Sub
Voir la pièce jointe
Pour l'impression, je te laisse essayer de ton coté, tu as déjà au moins un exemple ...