Discussion :

[kabamel]

Salut à tous,

J'ai une base de donnée dans lequel je veux faire un emploi du temps pour les enseignants. ainsi, j'ai téléchargé les exemples de base sur les plannings et agendas pour m'inspirer de leur structures, mais je me suis coincé et je ne sais pas où, étant novice en vba access. J'ai mis un exemple de base pour correction. Je suis à votre disposition pour plus d'info.

Merci pour votre aide précieuse.

[EricDgn]

A mon avis, il faudrait être plus précautionneux lors des copier-coller des macros et formulaires.
Il est important de bien comprendre ce que l'on copie. Il vaut mieux copier petit morceau par petit morceau pour bien voir ce qui se passe exactement.

Pour ce qui concerne le sous-formulaire SF_Emploi, il y a quelques corrections à apporter:
- au niveau des noms des champs: ils doivent tous être de la forme Hx_y où x est le n° de l'heure et y le n° du jour. Ce n'est pas partout respecté, pour commencer sur toute la ligne 1


- au niveau des noms des étiquettes de la colonne horaire, dont les noms devraient tous être de la forme Horairex où x est le n° de l'heure (mais je crois que cela n'aura pas d'importance pour le programme)

- au niveau des paramètres des fonctions, qui doivent tous être adaptés à la position de la cellule:


Personnellement, je n'ai pas vu l'utilité de la fonction SelectH(i,j)

Il manque le formulaire dénommé "F_Calendrier"

Voilà, je n'ai pas été plus loin.

Bonne continuation.

[kabamel]

Salut à tous. Merci beaucoup pour votre reponse.
Vous aviez vu juste, j'ai continué à faire des recherches sur les forums, j'ai vu un exemple type de ce que je cherche, mais le problème après modification, quand je tante de mettre un RDV à l'ouverture du formulaire "F_EProfesseur" quand je double clique sur un creneau, un msg apparait "Incompatibilité de type" et après remplissage le formulaire "F_EDTProfesseur" ne se met pas à jour, et si je double clique encore autre msg apparait "variable objet ou variable de bloc With non définie", j'ai essayé de corriger mais hélas. j'attends vos aides précieuses. je mets la base, pour plus d'info n'hésité pas. Merci

[EricDgn]

Bon, je n'ai pas encore compris comment tout cela devait fonctionner, mais voici toujours une version où le formulaire F_EProfesseur s'ouvre normalement.
Pour ce formulaire, j'y ai réactivé les boutons de déplacement: en disposer rend nettement plus facile la visualisation des enregistrements.
J'ai l'impression que c'était le déroulant "Professeur" qui devait servir à cela, mais si c'est vraiment cela, ce point du formulaire est mal conçu.
Bonne continuation.

[EricDgn]

Un point à éclaircir: quelles différences entre "disponibilités" et "matières", qui reçoivent aussi différentes couleurs.



Personnellement, je préfère présenter les relations en plaçant systématiquement les 1 à gauche, et les n à droite.

Bonne continuation.

[kabamel]

Salut à tous, Merci EricDgn pour votre réponse rapide
Jusqu'à présent le problème n'est résolu, bon je m'explique, Ouvrez le formulaire "F_EDTProfesseur", double-cliquez sur un créneau (par ex: créneau de 08:00) le formulaire "F_EProfesseur" s'ouvre avec le msg "Incompatibilité de type" modifier la date fin et la liste déroulante "Cours" puis cliquez sur "Ok", vous verrez.
autant pour moi, je dois supprimer la couleur dans les deux tables.

[kabamel]

De plus, la table disponibilie doit être supprimé

[EricDgn]

Ce message est provoqué par le chargement de la photo dans le sous-formulaire SF_EDTProfesseur par cette instruction:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Forms!F_EProfesseur!ImgPhoto.Picture = Forms!F_EProfesseur!txt_CheminPhoto
'--- sans doute à remplacer par
Forms!F_EProfesseur!ImgPhoto.Picture = nz(Forms!F_EProfesseur!txt_CheminPhoto)

Je n'ai pas vraiment cherché comment la corriger.

Pour plus facilement localiser les erreurs, il faut éviter d'utiliser les "On Error Goto ..."
Ces "on Error Goto ..." ne sont à utiliser que lorsque l'on veut traiter une erreur maitrisée, une erreur que l'on sait qu'elle va systématiquement se produire dans une certaine circonstance.

Bonne continuation.

[kabamel]

Oh là là !
vous êtes formidable. Merci

[kabamel]

Salut, J'ai encore un souci, je voudrais maintenant exporter le planning en excel via automation.
J'ai copié le code Cafeine et l'adapté, mais il y a une erreur qui apparait. voici le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
Function TransfertExcelAutomation()
 
    Dim xlApp As Excel.Application
    Dim xlSheet As Excel.Worksheet
    Dim xlBook As Excel.Workbook
    Dim I As Long, J As Long
    Dim t0 As Long, t1 As Long
 
    t0 = Timer
    Dim rec As Recordset
 
    Set rec = CurrentDb.OpenRecordset("R_NbHeureProf_Analyse croisée", dbOpenSnapshot)
 
    'Initialisations
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
 
    'Ajouter une feuille de calcul
    Set xlSheet = xlBook.Worksheets.Add
    xlSheet.Name = "Tutoriel"
 
    ' le titre
    '  écriture dans la cellule de ligne 1 et de colonne 1
    xlSheet.Cells(1, 1) = "Tableau recapitulatif des nombres d'heures"
 
 
    ' les entetes
    '  .Fields(Index).Name renvoie le nom du champ
    For J = 0 To rec.Fields.Count - 1
        xlSheet.Cells(2, J + 1) = rec.Fields(J).Name
        ' Nous appliquons des enrichissements de format aux cellules
        With xlSheet.Cells(2, J + 1)
            .Interior.ColorIndex = 15
            .Interior.Pattern = xlSolid
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).weight = xlThin
            .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
            .HorizontalAlignment = xlCenter
        End With
    Next J
 
    ' recopie des données à partir de la ligne 3
    I = 3
    Do While Not rec.EOF
        For J = 0 To rec.Fields.Count - 1
            ' .Fields(Index).Type renvoie le type du champ
            '   si c'est un Texte (dbText) nous insérons "'" pour
            '   qu'il soit reconnu par Excel comme du Texte
            If rec.Fields(J).Type = dbText Then
                xlSheet.Cells(I, J + 1) = "'" & rec.Fields(J)
            Else
                xlSheet.Cells(I, J + 1) = rec.Fields(J)
            End If
        Next J
        I = I + 1
        rec.MoveNext
    Loop
 
    ' code de fermeture et libération des objets
    xlBook.SaveAs "C:\Utilisateurs\Feuille.xls"
    xlApp.Quit
    rec.Close
    Set rec = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
 
    t1 = Timer
    Debug.Print I & " enregistrements", Format(t1 - t0, "0") & " secondes"
 
End Function

Et l'erreur ce produit là :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

    Set rec = CurrentDb.OpenRecordset("R_NbHeureProf_Analyse croisée", dbOpenSnapshot)

Merci pour votre aide.

[kabamel]

voici le planning en question
Merci

[EricDgn]

Il est indiqué qu'il manque 2 paramètres.
En fait ce sont les valeurs mises en paramètres de la requête R_Pres
Cette requête est emboitée dans la requête R_NbHeureProf, elle-même emboitée dans R_NbHeureProf_Analyse croisée

Un moyen d'inscrire ces 2 paramètres est de redéfinir la requête R_Pres dans la routine MajPlanning() en avant-dernière instruction.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
...
CurrentDb.QueryDefs("R_Pres").SQL = "SELECT IdProfesseur, DateJ, NbHeures FROM T_Presence " & _
                                    "WHERE Year([DateJ])= " & Form_F_Planning.An & " AND Month([DateJ])=" & Form_F_Planning.Mois
Forms!F_Planning!SF_Planning.Form.Requery
End Sub

Pour faciliter le suivi des opérations, dans la routine TransfertExcelAutomation(),
- j'ajouterais l'instruction xlApp.Visible
- je supprimerais (temporairement) l'instruction xlApp.Quit

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True

Bonne continuation.

[kabamel]

Salut à tous,
De ce coté parfait, mais plus loin il y a encore une erreur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
Function TransfertExcelAutomation()
 
    Dim xlApp As Excel.Application
    Dim xlSheet As Excel.Worksheet
    Dim xlBook As Excel.Workbook
 
    Dim I As Long, J As Long
    Dim t0 As Long, t1 As Long
 
    t0 = Timer
    Dim rec As DAO.Recordset
 
    Set rec = CurrentDb.OpenRecordset("R_NbHeureProf_Analyse croisée", dbOpenSnapshot)
    'Initialisations
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
 
    'Ajouter une feuille de calcul
    Set xlSheet = xlBook.Worksheets.Add
    xlSheet.Name = "Tutoriel"
 
    ' le titre
    '  écriture dans la cellule de ligne 1 et de colonne 1
    xlSheet.Cells(1, 1) = "Tableau recapitulatif des nombres d'heures"
 
 
    ' les entetes
    ' .Fields(Index).Name renvoie le nom du champ
    For J = 0 To rec.Fields.Count - 1
        xlSheet.Cells(2, J + 1) = rec.Fields(J).Name
        ' Nous appliquons des enrichissements de format aux cellules
        With xlSheet.Cells(2, J + 1)
            .Interior.ColorIndex = 15
            .Interior.Pattern = xlSolid
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).weight = xlThin
            .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
            .HorizontalAlignment = xlCenter
        End With
    Next J
 
    ' recopie des données à partir de la ligne 3
    I = 3
    Do While Not rec.EOF
        For J = 0 To rec.Fields.Count - 1
            ' .Fields(Index).Type renvoie le type du champ
            '   si c'est un Texte (dbText) nous insérons "'" pour
            '   qu'il soit reconnu par Excel comme du Texte
            If rec.Fields(J).Type = dbText Then
                xlSheet.Cells(I, J + 1) = "'" & rec.Fields(J)
            Else
                xlSheet.Cells(I, J + 1) = rec.Fields(J)
            End If
        Next J
        I = I + 1
        rec.MoveNext
    Loop
 
    ' Création du fichier Excel
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
 
    rec.Close
    Set rec = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
 
    t1 = Timer
    ' MsgBox (I & " enregistrements", Format(t1 - t0, "0") & " secondes")
    ' code de fermeture et libération des objets
    xlBook.SaveAs "C:\Utilisateurs\dkaba\Feuille.xls"
 
End Function

Juste à cette ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

xlBook.SaveAs "C:\Utilisateurs\dkaba\Feuille.xls"

Merci encore une fois

[EricDgn]

Essayer avec Feuille.xlsx (pas testé).

[kabamel]

Parfait

[kabamel]

Salut à tous,
Encore un problème, dans la discution #12 EricDgn m'avais proposé une solution par rapport à la fonction "TransfertExcelAutomation" dont il s'agissait de de redéfinir la requête R_Pres dans la routine MajPlanning(), quand je lance l'export il n' y a pas de problème mais après la requête "R_Pres" est immédiatement modifiée en :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
SELECT T_Presence.IdProfesseur, T_Presence.DateJ, T_Presence.NbHeures
FROM T_Presence
WHERE (((Year([DateJ]))=2016) AND ((Month([DateJ]))=4));

or cela devrait se présenter comme ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
SELECT IdProfesseur, DateJ, NbHeures 
FROM T_Presence 
WHERE Year([DateJ])= " & Form_F_Planning.An & " AND Month([DateJ])=" & Form_F_Planning.Mois

Je ne sais pas comment remédié, J'attends votre aide
Merci

[EricDgn]

Pourquoi faut-il donc re-modifier la formule ?
Dans la partie WHERE Year([DateJ])=2016 AND Month([DateJ])=4
en pratique
2016 = Form_F_Planning.An
4 = Form_F_Planning.Mois
A chaque clic du bouton "Format Excel" la requête R_Pres est réévaluée avant d'ouvrir Excel.

[kabamel]

Merci EricDgn. (autant pour moi, je pense que c'est pas le clique du bouton mais plutot à l'ouverture du form "F_Planning")
Voici le sql de la requête "R_Pres" avant ouverture du formulaire "F_Planning"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
SELECT T_Presence.IdProfesseur, T_Presence.DateJ, T_Presence.NbHeures
FROM T_Presence
WHERE (((Year([DateJ]))=[Formulaires]![F_Planning]![An]) AND ((Month([DateJ]))=[Formulaires]![F_Planning]![Mois]));

Et dès l'ouverture du formulaire "F_Planning" la requête "R_Pres" est immédiatement modifié en :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
SELECT T_Presence.IdProfesseur, T_Presence.DateJ, T_Presence.NbHeures
FROM T_Presence
WHERE (((Year([DateJ]))=2016) AND ((Month([DateJ]))=4));

Je me demande pourquoi cette modif, voilà je cherche à corriger cela, téléchargé "PlanningTransfert" dans la discution #11 pour voir
Merci.

[EricDgn]

Le moyen le plus simple est sans doute de remettre la requête R_Pres dans sa formulation initiale à l'ouverture de F_Planning (Sur Ouverture), ou en dernière instruction de MajPlanning(). A tester.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
CurrentDb.QueryDefs("R_Pres").SQL = "SELECT IdProfesseur, DateJ, NbHeures FROM T_Presence " & _
                                    "WHERE Year([DateJ])= Form_F_Planning.An  AND Month([DateJ])= Form_F_Planning.Mois"

Note: Form_Open() s'exécute avant Form_Load()
Cdt.

[kabamel]

Jusqu'à présent aucun changement, je vous mets le fichier
Allons pas à pas, j'ai positionné la requête "R_Pres" sur le bon code sql, mettez le en mode création pour voir, ensuite fermer "R_Pres" et ouvrer le formulaire "F_Planning", refermer le, ouvré de nouveau "R_Pres" en mode création, vous verrez qu'il y a changement.
voilà ce que je cherche à corriger.