Discussion :

[morobaboumar]

Bonjour membres du forum.
Je souhaiterais que quelqu'un m'aide à corriger les codes suivants me permettant d'importer
des informations de notes scolaires enregistrées d'Excel et les enregistrer dans Access.

Code :

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

1
2
3
4
5
Option Compare Database
 
Private Sub bt_fermer_Click()
DoCmd.Close
End Sub

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
Private Sub bt_Selection_Click()
'Déclaration des variables
Dim strFichier As String
Dim oFD As FileDialog
Dim AncienNom As String
Dim NouvNom As String
 
'Paramètre la fenêtre Ouvrir
Set oFD = Application.FileDialog(msoFileDialogOpen)
With oFD
    'Ajoute les filtres pour fichiers
    With .Filters
        .Clear
        .Add "Fichiers Excel", "*.xls;*.xlsx;*.xlsm"
    End With
 
    'Renseignement du titre
 
    .Title = "Fichier des Notes pour " & Me.txtCLASSE & "-" & Me.txtCOMPO & "-" & Me.txtANNEE & "-ARABE"
 
        'Ouvre l'explorateur dans le fichier 'Mes documents' du User connecté.
    '.InitialFileName = Environ("USERPROFILE") & "\Mes documents"
    .InitialFileName = CurrentProject.Path
 
    .AllowMultiSelect = False
    'Permet de choisir le mode d'affichage dans l'explorateur (ici apperçu)
    .InitialView = msoFileDialogViewThumbnail
    'Permet de personnaliser le bouton.
    .ButtonName = "Choisir un fichier"
    'Affiche la fenêtre
 
 
    If .Show Then
            Me.sCheminFichier = .SelectedItems(1)
            RemplirListeClasseurs
    End If
End With
End Sub

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
Sub RemplirListeClasseurs()
On Error Resume Next
Dim App As Excel.Application
Dim Classeur As Excel.Worksheet
Dim strFichier As String            'Nom du fichier Excel
Dim i As Integer
Dim Nb As Integer
strFichier = Me.sCheminFichier
Set App = CreateObject("Excel.application")     'Ouverture d'Excel
App.Workbooks.Open strFichier                   'Ouverture du fichier à traiter
With App
    'Vidage de la liste
    Do While Me.ListeClasseurs.ListCount > 0
        DoEvents
        'Nb = Me.ListeClasseurs.ListCount
        'For i = 0 To Me.ListeClasseurs.ListCount - 1
            Me.ListeClasseurs.RemoveItem 0
            Me.ListeClasseurs.Requery
        'Next i
    Loop
 
    'Remplissage de la liste
    For Each Classeur In .Worksheets
    DoEvents
        Me.ListeClasseurs.AddItem Classeur.Name
    Next
End With
' ferme excel
App.Workbooks.Close
 
App.Quit
 
Set App = Nothing
Set Classeur = Nothing
End Sub

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
Sub CreerTableEtImporterDonnees()
    Dim dbs As DAO.Database
    Dim strNomTable As String
    Dim strSQL As String
    Dim rst As DAO.Recordset
    Dim i As Integer
    Dim strChamp As String
    Dim Fichier As String
    Dim Feuille As String
    Dim n As Integer
    Dim strMsg As String
 
 
    strSQL = "SELECT * FROM MATIERE_CLASSE_AR WHERE annee_scol='" & Me.txtANNEE & "' AND classe_arabe ='" & Me.txtCLASSE & "' AND NumCompoMCAr =" & Me.txtCOMPO & " AND Identif_Etablis =" & Me.Txt_ETABLISSEMENT & ";"
    'strNomTable = "Temp_" & Left(Me.txtCOMPO, 1) & Right(Me.txtCOMPO, 11) & "_" & Right(Me.txtANNEE, 4)
    strNomTable = "Temp_Importation_NotesExcel"
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset(strSQL)
    If TableExiste(strNomTable) Then
        SupprimerTable (strNomTable)
        'MsgBox "Elle existe"
    End If
    strSQL = "CREATE TABLE  [" & strNomTable & "] (Appreciation CHAR, Classement CHAR, MOYENNE REAL, TOTAL REAL,CompositionArabe REAL,Etablissement REAL);"
    DoCmd.SetWarnings False
    dbs.Execute strSQL
        If Not rst.EOF Then
            rst.MoveLast
            Do While Not rst.BOF
                strChamp = fSENS_parID_Matiere_AR(rst.Fields("matiere_arabe"))
 
                strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN [" & strChamp & "] REAL;"
                DoEvents
                dbs.Execute strSQL
 
                rst.MovePrevious
            Loop
        End If
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN NomEleveAr CHAR;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN mle_Eleve INTEGER;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN ClasseArabe CHAR;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN anscol CHAR;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN CompoArabe CHAR;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN ID_Etab CHAR;"
        DoEvents
        dbs.Execute strSQL
 
 Fichier = Me.sCheminFichier
 Feuille = Me.ListeClasseurs & "!"
 
    DoCmd.RunSQL "DELETE * FROM   " & strNomTable & ";"
 
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, strNomTable, Fichier, True, Feuille
 
    DoCmd.SetWarnings True
 
rst.Close
Set rst = Nothing
End Sub

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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
Sub InserrerNotes(vAnScol As String, vClas As String, vCompo As String, vIDeta As Long)
On Error Resume Next
    Dim dbs As DAO.Database
    Dim strSQL As String
    Dim strSQL_Eleve As String
    Dim rst As DAO.Recordset
    Dim rstEleve As DAO.Recordset
    Dim i As Integer
    Dim strNomTable As String
 
    'Variables de l'entête de la compo
    Dim stAnnee As String
    Dim vMle_El As Long
    Dim vClasse As String
    Dim vNatCompo As Long
    Dim vStatut As String
    Dim vEtablis As Long
    Dim n As Integer
 
    Dim sCoef As Integer
    Dim idAuto As Long
    Dim idComp As Long
    Dim NumMat As Long
    Dim LaNote As Single
 
    strSQL_Eleve = "SELECT * FROM Req_Eleve_INSCRIT WHERE ID_ETABL_FREQ=" & vIDeta & "and ANNEE_SCOL='" & vAnScol & "' AND ClasseArabe ='" & vClas & "';"
 
    'strNomTable = "Temp_" & Left(vCompo, 1) & Right(vCompo, 11) & "_" & Right(vAnScol, 4)
    strNomTable = "Temp_Importation_NotesExcel"
 
    Set dbs = CurrentDb
 
    Set rstEleve = dbs.OpenRecordset(strSQL_Eleve)
 
    If Not rstEleve.EOF Then    'On boucle sur la liste des élèves de la classe
        rstEleve.MoveFirst
 
        Do While Not rstEleve.EOF
 
        DoEvents
 
        Me.lblMessage.Caption = "Traitement de l'élève n°" & rstEleve.Fields("Mleeleve") & "-" & rstEleve.Fields("NPrenomsEleves") & " " & rstEleve.Fields("NPrenomsElevesAR")
        Me.lblMessage.Visible = True
 
        strSQL = "SELECT * FROM " & strNomTable & " WHERE mle_Eleve =" & rstEleve.Fields("Mleeleve") & " AND anscol='" & vAnScol & "' AND CompoArabe =" & vCompo & " AND ID_Etab =" & vIDeta & ";"
        Set rst = dbs.OpenRecordset(strSQL)
        If Not rst.EOF Then
            n = 3
            rst.MoveFirst
            Do While Not rst.EOF
 
            DoEvents
 
            'Initialisation de l'entête de des notes [INFOS_COMPOSITION_ARABE] pour l'élève actif
                idComp = NumeroAutoCompoArabes() + 1
                stAnnee = vAnScol
                vMle_El = rstEleve.Fields("Mleeleve")
                vClasse = vClas
                vNatCompo = vCompo
                vStatut = "Classé"
                vEtablis = vIDeta
                If CompoDejaImportée_Ar(Me.txtANNEE, rstEleve("Mleeleve"), Me.txtCLASSE, Me.txtCOMPO, Me.Txt_ETABLISSEMENT) = False Then
 
                strSQL = "INSERT INTO INFOS_COMPOSITION_ARABE (idCompoA, anscol, mle_Eleve, ClasseArabe, CompoArabe, Statut,ID_Etab) VALUES (" & idComp & ", '" & stAnnee & "', " & vMle_El & ", '" & vClasse & "', '" & vNatCompo & "', '" & vStatut & "', '" & vEtablis & " );"
                DoCmd.SetWarnings False
                DoCmd.RunSQL strSQL
 
                    idAuto = f_NumeroAutoNotesCompoArabes()
 
                    DoEvents
 
                    For i = 1 To Me.NbreMatiere
                        DoEvents
                        idAuto = idAuto + 1
                        NumMat = CLng(fIDM_parSENS_MATIERE_AR(rst.Fields(n + i).Name))
 
                            'Teste le contenu des cellules de notes
                            If IsNull(rst.Fields(n + i).Value) Then
                            LaNote = 0
                            Else
                            LaNote = CSng(rst.Fields(n + i).Value)
                            End If
 
                        sCoef = fCOEF_parMATIERE_AR(Me.txtANNEE, Me.txtCLASSE, fIDM_parSENS_MATIERE_AR(rst.Fields(n + i).Name))
 
                        strSQL = "INSERT INTO NOTES_CLASSES_ARABES (idNotesArabe, idCA, matiereAr, coef) VALUES (" & idAuto & ", " & idComp & ", " & NumMat & ", " & sCoef & " );"
                        DoCmd.SetWarnings False
                        DoCmd.RunSQL strSQL
 
                        strSQL = "update NOTES_CLASSES_ARABES set NOTES_CLASSES_ARABES.Note =" & Replace(LaNote, ",", ".") & _
                        " where NOTES_CLASSES_ARABES.idNotesArabe =" & idAuto & ";"
                        DoCmd.SetWarnings False
                       DoCmd.RunSQL strSQL
                        strSQL = ""
                    Next i
                Else
                    Me.lblMessage.Caption = "Notes déjà importées pour l'élève n°" & rstEleve.Fields("Mleeleve") & "-" & rstEleve.Fields("nom") & " " & rstEleve.Fields("prenom")
                    Me.lblMessage.Visible = True
                End If
                rst.MoveNext
                Loop
 
            End If
            rstEleve.MoveNext
            Loop
 
            MsgBox "Transfert effectué avec succès !"
            DoCmd.OpenForm "CLASSEARABE", , , "[classeArabe]='" & Me.txtCLASSE & "' AND [ANNEE_SCOL]='" & Me.txtANNEE & "'", , , "PF"
            'DoCmd.OpenForm stDoc, , , "[ClasseFrancais]='" & Me.lstCLASSES_FR_DISPO & "' AND [ANNEE_SCOL]='" & Me.lstANNEE_SCOLAIRE & "'", , , "PF"
            DoCmd.Close acForm, "frmIMPORTER_NOTES_FichEXCEL_Ar"
            rst.Close
            rstEleve.Close
 
            Set rst = Nothing
            Set rstEleve = Nothing
 
             ' Supprime la Table temporaire.
 
            'dbs.Execute "DROP TABLE " & strNomTable & ";"
            DoCmd.SetWarnings True
    End If
End Sub

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
Private Sub btn_Traitement_Click()
 
DoCmd.SetWarnings False
'Création et importation des données
    CreerTableEtImporterDonnees
    Me.lblMessage.Caption = "Création et importation des données..."
    Me.lblMessage.Visible = True
    DoEvents
 
 
'Transfert des données de la table tampon vers la table des notes
    InserrerNotes Me.txtANNEE, Me.txtCLASSE, Me.txtCOMPO, Me.Txt_ETABLISSEMENT
 
    'Me.lblMessage.Caption = "Création et importation des données..."
    'Me.lblMessage.Visible = False
 
    DoEvents
DoCmd.SetWarnings True
 
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
Private Sub Form_Load()
DoCmd.MoveSize 2700, 1000, 14000, 6000
'Me.NumCol = 3
'Me.NumColDepart = 6
If Not IsNull(Me.sCheminFichier) Then
    DoEvents
    RemplirListeClasseurs
End If
End Sub

Voici comment atteindre le formulaire d'import de notes:
1°) Cliquer sur la commande"SCOLARISATION _ Ajout Informations"
2°) Cliquer sur la commande"ETABLISSEMENT SCOLAIRES ET SERVICES DIVERS _ Ajout Informations" du 2e onglet du Formulaire"SCOLARISATION"
3°) Cliquer sur la commande"APERCU DES ELEVES DE L'ECOLE EN COURS" du 3e onglet du Formulaire"EtablissementScol_Service"
4°) Cliquer sur la commande "LISTE_DE_COMPOSITIONS Mtle & Primaire" du formulaire qui s'affiche,
5°) Selectionner la 3e compsition, puis une classe d'arabe, ensuite cliquer sur la commande"ENREGISTRER NOTES DE COMPOSITIONS:"
6°) Cliquer sur la commande"Importer des Notes d'EXCEL [Arabe]"
7°) Et voila le formulaire importateur de notes scolaire depuis Excel.

Ci-joint: 2 pieces jointes.
Très cordialement

[EricDgn]

Bonjour,

Je n'ai pas résolu votre problème, mais voici toujours un élément qui devrait vous permettre d'avancer.

Dans le formulaire frmIMPORTER_NOTES_FichEXCEL_Ar, après avoir supprimé tous les SetWarnings False, un bug se produit au niveau de cette instruction:

Code :

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

    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, strNomTable, Fichier, True, Feuille

qui marche presque après l'avoir remplacée par celle-ci:

Code :

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

    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, strNomTable, Fichier, True, Feuille & "!A1:R33"

mais cela permet de constater que la la table temporaire ne dispose pas de tous les champs nécessaires!

A mon avis, plutôt que d'utiliser des tables temporaires pour y importer les données Excel, il serait plus efficace de "lier" temporairement les feuilles Excel (ce qui a aussi l'avantage de ne pas charger la db). Ces feuilles Excel "liées" sont ensuite utilisées comme des tables ordinaires.

Bonne continuation.

[Invité]

Bonsoir,
Il faut considérer Excel comme une base de données!
https://mon-partage.fr/f/LoCWKVjq/

[morobaboumar]

Salut Membre du forum!

Pourquoi ce programme "importer des données d'excel à Access ?"
Parce qu'il me permet d'importer des notes saisies dans excel et ordonnées
selon l'ordre des matières programmées dans Access:
- concernant les matières arabes qui partent de la droite vers la gauche:
(Appreciation,Classement,MOYENNE,Total)
(CompoArabe,et les Matieres dans l'ordre de la droite vers la gauche,Identifiant de l'Etablissement)
(anscol,mle_Eleve,NomEleveAr,ClasseArabe)
Maintenant, là où mes difficultes sont situées, c'est au niveau des codes:

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
Sub CreerTableEtImporterDonnees()
    Dim dbs As DAO.Database
    Dim strNomTable As String
    Dim strSQL As String
    Dim rst As DAO.Recordset
    Dim I As Integer
    Dim strChamp As String
    Dim Fichier As String
    Dim Feuille As String
    Dim N As Integer
    Dim strMsg As String
 
    strSQL = "SELECT * FROM MATIERE_CLASSE_AR WHERE annee_scol='" & Me.txtANNEE & "' AND classe_arabe ='" & Me.txtCLASSE & "' AND NumCompoMCAr =" & Me.txtCOMPO & " AND Identif_Etablis =" & Me.Txt_ETABLISSEMENT & ";"
    'strNomTable = "Temp_" & Left(Me.txtCOMPO, 1) & Right(Me.txtCOMPO, 11) & "_" & Right(Me.txtANNEE, 4)
    strNomTable = "Temp_Importation_NotesExcel"
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset(strSQL)
    If TableExiste(strNomTable) Then
        SupprimerTable (strNomTable)
        'MsgBox "Elle existe"
    End If
    strSQL = "CREATE TABLE  [" & strNomTable & "] (Appreciation CHAR, Classement CHAR, MOYENNE REAL, TOTAL REAL);"
    DoCmd.SetWarnings False
    dbs.Execute strSQL
        If Not rst.EOF Then
            rst.MoveLast
            Do While Not rst.BOF
                strChamp = fSENS_parID_Matiere_AR(rst.Fields("matiere_arabe"))
 
                strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN [" & strChamp & "] REAL;"
                DoEvents
                dbs.Execute strSQL
 
                rst.MovePrevious
            Loop
        End If
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN NomEleveAr CHAR;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN mle_Eleve INTEGER;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN ClasseArabe CHAR;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN anscol CHAR;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN CompoArabe INTEGER;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN ID_ECOLE INTEGER;"
        DoEvents
        dbs.Execute strSQL
 
 Fichier = Me.sCheminFichier
 Feuille = Me.ListeClasseurs & "!"
 
    DoCmd.RunSQL "DELETE * FROM   " & strNomTable & ";"
 
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, strNomTable, Fichier, True, Feuille
 
    DoCmd.SetWarnings True
 
rst.Close
Set rst = Nothing
End Sub

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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
Sub InserrerNotes(vIdEtab As Long, vAnScol As String, vClas As String, vCompo As Long)
On Error Resume Next
    Dim dbs As DAO.Database
    Dim strSQL As String
    Dim strSQL_Eleve As String
    Dim rst As DAO.Recordset
    Dim rstEleve As DAO.Recordset
    Dim I As Integer
    Dim strNomTable As String
 
    'Variables de l'entête de la compo
    Dim stAnnee As String
    Dim vMle_El As Long
    Dim vClasse As String
    Dim vNatCompo As String
    Dim vStatut As String
    Dim vID_Ecole As Long
    Dim N As Integer
 
    Dim sCoef As Integer
    Dim idAuto As Long
    Dim idComp As Long
    Dim NumMat As Long
    Dim LaNote As Single
    Dim sID_Ecole As Long
 
    strSQL_Eleve = "SELECT * FROM ReqINFOS_COMPOSITION_ARABE_BilanAnnuelComposition WHERE ID_Etab=" & vIdEtab & " AND anscol ='" & vAnScol & "' AND ClasseArabe ='" & vClas & "';"
 
    'strNomTable = "Temp_" & Left(vCompo, 1) & Right(vCompo, 11) & "_" & Right(vAnScol, 4)
    strNomTable = "Temp_Importation_NotesExcel"
 
    Set dbs = CurrentDb
 
    Set rstEleve = dbs.OpenRecordset(strSQL_Eleve)
 
    If Not rstEleve.EOF Then    'On boucle sur la liste des élèves de la classe
        rstEleve.MoveFirst
 
        Do While Not rstEleve.EOF
 
        DoEvents
 
        Me.lblMessage.Caption = "Traitement de l'élève n°" & rstEleve.Fields("mle_Eleve") & "-" & NomPrenomEleveFrancais("mle_Eleve") & " " & NomPrenomEleveArabe("mle_Eleve")
        Me.lblMessage.Visible = True
 
        strSQL = "SELECT * FROM " & strNomTable & " WHERE mle_Eleve =" & rstEleve.Fields("Mleeleve") & " AND anscol='" & vAnScol & "' AND CompoArabe =" & vCompo & ";"
        Set rst = dbs.OpenRecordset(strSQL)
        If Not rst.EOF Then
            N = 3
            rst.MoveFirst
            Do While Not rst.EOF
 
            DoEvents
 
            'Initialisation de l'entête de des notes [INFOS_COMPOSITION_ARABE] pour l'élève actif
                idComp = NumeroAutoCompoArabes() + 1
                vID_Ecole = vIdEtab
                stAnnee = vAnScol
                vMle_El = rstEleve.Fields("Mleeleve")
                vClasse = vClas
                vNatCompo = vCompo
                vStatut = "Classé"
 
 
                If CompoDejaImportée_Ar(Me.txtANNEE, rstEleve("Mleeleve"), Me.txtCLASSE, Me.txtCOMPO, Me.Txt_ETABLISSEMENT) = False Then
 
                strSQL = "INSERT INTO INFOS_COMPOSITION_ARABE (idCompoA, anscol, mle_Eleve, ClasseArabe, CompoArabe, Statut,ID_Etab) VALUES (" & idComp & ", '" & stAnnee & "', " & vMle_El & ", '" & vClasse & "', '" & vNatCompo & "', '" & vStatut & "', '" & vIdEtab & "' );"
                DoCmd.SetWarnings False
                DoCmd.RunSQL strSQL
 
                    idAuto = NumeroAutoNotesArabes()
 
                    DoEvents
 
                    For I = 1 To Me.NbreMatiere
                        DoEvents
                        idAuto = idAuto + 1
                        NumMat = CLng(fIDM_parSENS_MATIERE_AR(rst.Fields(N + I).Name))
 
                            'Teste le contenu des cellules de notes
                            If IsNull(rst.Fields(N + I).Value) Then
                            LaNote = 0
                            Else
                            LaNote = CSng(rst.Fields(N + I).Value)
                            End If
 
                        sCoef = fCOEF_parMATIERE_AR(Me.txtANNEE, Me.txtCLASSE, fIDM_parSENS_MATIERE_AR(rst.Fields(N + I).Name))
 
                        strSQL = "INSERT INTO NOTES_CLASSES_ARABES (idNotesArabe, idCA, matiereAr, coef,Ident_Etabl) VALUES (" & idAuto & ", " & idComp & ", " & NumMat & ", " & sCoef & " );"
                        DoCmd.SetWarnings False
                        DoCmd.RunSQL strSQL
 
                        strSQL = "update NOTES_CLASSES_ARABES set NOTES_CLASSES_ARABES.Note =" & Replace(LaNote, ",", ".") & _
                        " where NOTES_CLASSES_ARABES.idNotesArabe =" & idAuto & ";"
                        DoCmd.SetWarnings False
                       DoCmd.RunSQL strSQL
                        strSQL = ""
                    Next I
                Else
                    Me.lblMessage.Caption = "Notes déjà importées pour l'élève n°" & rstEleve.Fields("Mleeleve") & "-" & rstEleve.Fields("nom") & " " & rstEleve.Fields("prenom")
                    Me.lblMessage.Visible = True
                End If
                rst.MoveNext
                Loop
 
            End If
            rstEleve.MoveNext
            Loop
 
            MsgBox "Transfert effectué avec succès !"
            DoCmd.OpenForm "CLASSEARABE", , , "[classeArabe]='" & Me.txtCLASSE & "' AND [ANNEE_SCOL]='" & Me.txtANNEE & "'", , , "PF"
            'DoCmd.OpenForm stDoc, , , "[ClasseFrancais]='" & Me.lstCLASSES_FR_DISPO & "' AND [ANNEE_SCOL]='" & Me.lstANNEE_SCOLAIRE & "'", , , "PF"
            DoCmd.Close acForm, "frmIMPORTER_NOTES_FichEXCEL_Ar"
            rst.Close
            rstEleve.Close
 
            Set rst = Nothing
            Set rstEleve = Nothing
 
             ' Supprime la Table temporaire.
 
            'dbs.Execute "DROP TABLE " & strNomTable & ";"
            DoCmd.SetWarnings True
    End If
End Sub

Plus efficace de "lier" temporairement les feuilles Excel (ce qui a aussi l'avantage de ne pas charger la db). Ces feuilles Excel "liées" sont ensuite utilisées comme des tables ordinaires.

Donnez moi des exemples de catalogue du comment relier les feuilles Excel une base de données Access avec des plus de détails écrits appuyées par des images.
Très cordialement

[EricDgn]

Bonjour,
Une piste sur ce post: lier à ACCESS une plage d'une feuille EXCEL
point essentiel: acLink (au lieu de acImport)
Bonne continuation.

[morobaboumar]

La propriété "acLink" marche avec mon 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
72
73
Sub CreerTableEtImporterDonnees()
    Dim dbs As DAO.Database
    Dim strNomTable As String
    Dim strSQL As String
    Dim rst As DAO.Recordset
    Dim I As Integer
    Dim strChamp As String
    Dim Fichier As String
    Dim Feuille As String
    Dim N As Integer
    Dim strMsg As String
 
    strSQL = "SELECT * FROM MATIERE_CLASSE_AR WHERE annee_scol='" & Me.txtANNEE & "' AND classe_arabe ='" & Me.txtCLASSE & "' AND NumCompoMCAr =" & Me.txtCOMPO & " AND Identif_Etablis =" & Me.Txt_ETABLISSEMENT & ";"
    'strNomTable = "Temp_" & Left(Me.txtCOMPO, 1) & Right(Me.txtCOMPO, 11) & "_" & Right(Me.txtANNEE, 4)
    strNomTable = "Temp_Importation_NotesExcel"
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset(strSQL)
    If TableExiste(strNomTable) Then
        SupprimerTable (strNomTable)
        'MsgBox "Elle existe"
    End If
    strSQL = "CREATE TABLE  [" & strNomTable & "] (Appreciation CHAR, Classement CHAR, MOYENNE REAL, TOTAL REAL);"
    DoCmd.SetWarnings False
    dbs.Execute strSQL
        If Not rst.EOF Then
            rst.MoveLast
            Do While Not rst.BOF
                strChamp = fSENS_parID_Matiere_AR(rst.Fields("matiere_arabe"))
 
                strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN [" & strChamp & "] REAL;"
                DoEvents
                dbs.Execute strSQL
 
                rst.MovePrevious
            Loop
        End If
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN NomEleveAr CHAR;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN mle_Eleve INTEGER;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN ClasseArabe CHAR;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN anscol CHAR;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN CompoArabe INTEGER;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN ID_ECOLE INTEGER;"
        DoEvents
        dbs.Execute strSQL
 
 Fichier = Me.sCheminFichier
 Feuille = Me.ListeClasseurs & "!"
 
    DoCmd.RunSQL "DELETE * FROM   " & strNomTable & ";"
 
    DoCmd.TransferSpreadsheet acLink , acSpreadsheetTypeExcel12, strNomTable, Fichier, True, Feuille
 
    DoCmd.SetWarnings True
 
rst.Close
Set rst = Nothing
End Sub

que je voudrais adapter au code suivant:

Code :

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

1
2
3
4
if isbroken ("XXX") then
chemin_res = DLookup("[chemin_fic_réseau]", "Table_chemin", "[id_fic] = 1")
DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel9, "Table_liée", chemin_res & "\" & "fichier_source.xls", True, "onglet!cellules"
endif

sans créer de table temporaire.

Je vous prie de me montrer la fonction isbroken.
Quelle est est sa référence ?
Très cordialement.

[Invité]

Bonsoir,
Tu veux vraiment pas tester ma solution?

texte_SQL= "SELECT DISTINCT [DESTINAT], [MONTANT], [NBRCOLIS] FROM [" & NomFeuille & "$] in '" & FichierXls & "' 'excel 12.0;HDR=Yes;IMEX=1;'"

[morobaboumar]

Merci d'avance dysorthographie.

Code :

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

texte_SQL = "SELECT DISTINCT [DESTINAT], [MONTANT], [NBRCOLIS] FROM [" & NomFeuille & "$] in '" & FichierXls & "' 'excel 12.0;HDR=Yes;IMEX=1;'"

Je voudrais savoir où placer votre code en l'adaptant au code suivant:

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
Sub CreerTableEtImporterDonnees()
    Dim dbs As DAO.Database
    Dim strNomTable As String
    Dim strSQL As String
    Dim rst As DAO.Recordset
    Dim I As Integer
    Dim strChamp As String
    Dim Fichier As String
    Dim Feuille As String
    Dim N As Integer
    Dim strMsg As String
 
    strSQL = "SELECT * FROM MATIERE_CLASSE_AR WHERE annee_scol='" & Me.txtANNEE & "' AND classe_arabe ='" & Me.txtCLASSE & "' AND NumCompoMCAr =" & Me.txtCOMPO & " AND Identif_Etablis =" & Me.Txt_ETABLISSEMENT & ";"
    'strNomTable = "Temp_" & Left(Me.txtCOMPO, 1) & Right(Me.txtCOMPO, 11) & "_" & Right(Me.txtANNEE, 4)
    strNomTable = "Temp_Importation_NotesExcel"
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset(strSQL)
    If TableExiste(strNomTable) Then
        SupprimerTable (strNomTable)
        'MsgBox "Elle existe"
    End If
    strSQL = "CREATE TABLE  [" & strNomTable & "] (Appreciation CHAR, Classement CHAR, MOYENNE REAL, TOTAL REAL);"
    DoCmd.SetWarnings False
    dbs.Execute strSQL
        If Not rst.EOF Then
            rst.MoveLast
            Do While Not rst.BOF
                strChamp = fSENS_parID_Matiere_AR(rst.Fields("matiere_arabe"))
 
                strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN [" & strChamp & "] REAL;"
                DoEvents
                dbs.Execute strSQL
 
                rst.MovePrevious
            Loop
        End If
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN NomEleveAr CHAR;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN mle_Eleve INTEGER;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN ClasseArabe CHAR;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN anscol CHAR;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN CompoArabe INTEGER;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN ID_ECOLE INTEGER;"
        DoEvents
        dbs.Execute strSQL
 
 Fichier = Me.sCheminFichier
 Feuille = Me.ListeClasseurs & "!"
 
    DoCmd.RunSQL "DELETE * FROM   " & strNomTable & ";"
 
    DoCmd.TransferSpreadsheet acLink , acSpreadsheetTypeExcel12, strNomTable, Fichier, True, Feuille
 
    DoCmd.SetWarnings True
 
rst.Close
Set rst = Nothing
End Sub

sans créer de table temporaire.
Merci infiniment.

[Invité]

Bonjour,

Code :

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

1
2
  strSQL = "SELECT * FROM [MATIERE_CLASSE_AR$] in 'c:\rep\fichier.xlsx' 'excel 12.0;HDR=Yes;IMEX=1;' WHERE annee_scol='" & Me.txtANNEE & "' AND classe_arabe ='" & Me.txtCLASSE & "' AND NumCompoMCAr =" & Me.txtCOMPO & " AND Identif_Etablis =" & Me.Txt_ETABLISSEMENT & ";"
Set rst = dbs.OpenRecordset(strSQL)

Code :

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

1
2
3
  strSQL = "SELECT * into [toto] FROM [MATIERE_CLASSE_AR$] in 'c:\rep\fichier.xlsx' 'excel 12.0;HDR=Yes;IMEX=1;' WHERE annee_scol='" & Me.txtANNEE & "' AND classe_arabe ='" & Me.txtCLASSE & "' AND NumCompoMCAr =" & Me.txtCOMPO & " AND Identif_Etablis =" & Me.Txt_ETABLISSEMENT & ";"
 
Currentdb.execute strSQL

Pour bien comprendre reprends la vidéo en lien au poste #3.

[morobaboumar]

Bonjour membres du forum,
Je n'arrive toujours pas a trouver de solution à mon problème.

- L' objetif de ma BD est d'enregistrer directement les notes scolaires dans Access mais pas de créer
une liaison entre Excel et Access. Car cette liaison surcharge ma base de données Access.

- Dans le cas où les notes sont saisies dans Excel, alors pour les enregistrer dans Access, je préfère
les y importer grâce au formulaire conçu à cet effet. Donc, la table temporaire "Temp_Importation_NotesExcel"
me facilite la tache et m'éviter de créer des tables supplémentaires selon chaque matière et note des différentes
classes.

Mon souci se trouver au niveau des codes de la commande"btn_Traitement(LANCER LE TRAITEMENT...)" du formulaire "frmIMPORTER_NOTES_FichEXCEL_Ar".

J'ai essayé de corriger les codes, mais toujours un blocage: Message d'erreur d'exécution 3380 "le champ d’écriture existe déja dans la table: Temp_Importation_NotesExcel".

-je vous renvoie la piece-jointe que j'ai essayé de corriger.
Veuillez m'aider à y trouver la solution et le mettre en exécution dans ma base de données SVP.
Merci EricDgn, Dysorthographie pour vos aides
si précieuses.
Encore une fois, sollicite votre apport.
Merci infiniment !

[morobaboumar]

Bonjour,

Code :

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

1
2
  strSQL = "SELECT * FROM [MATIERE_CLASSE_AR$] in 'c:\rep\fichier.xlsx' 'excel 12.0;HDR=Yes;IMEX=1;' WHERE annee_scol='" & Me.txtANNEE & "' AND classe_arabe ='" & Me.txtCLASSE & "' AND NumCompoMCAr =" & Me.txtCOMPO & " AND Identif_Etablis =" & Me.Txt_ETABLISSEMENT & ";"
Set rst = dbs.OpenRecordset(strSQL)

Code :

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

1
2
3
  strSQL = "SELECT * into [toto] FROM [MATIERE_CLASSE_AR$] in 'c:\rep\fichier.xlsx' 'excel 12.0;HDR=Yes;IMEX=1;' WHERE annee_scol='" & Me.txtANNEE & "' AND classe_arabe ='" & Me.txtCLASSE & "' AND NumCompoMCAr =" & Me.txtCOMPO & " AND Identif_Etablis =" & Me.Txt_ETABLISSEMENT & ";"
 
Currentdb.execute strSQL

Pour bien comprendre reprends la vidéo en lien au poste #3.

Bonjour dysorthographie !
Je vous prie de bien vouloir introduire les codes ci-dessus dans la commande: btn_Traitement"LANCER LE TRAITEMENT..."
afin que je puisse bien comprendre le fonctionnement. SVP.
Toute fois, il aurait fallut que vous m'excusassiez pour toute erreur commise.
Merci infiniment

[EricDgn]

Bonjour,
Une façon de faire, en liant temporairement la feuille Excel pour récupérer les données (lien effacé après reprise des données):

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
Private Sub btn_Traitement_Click()
    DelierTableExcel                '--- surtout utile pendant mise au point !
    LierTableExcel                  '--- Lier à la feuille Excel sélectionnée
    InserrerNotes Me.Txt_ETABLISSEMENT, Me.txtANNEE, Me.txtCLASSE, Me.txtCOMPO
    DelierTableExcel
End Sub
 
Sub LierTableExcel()
   Dim strNomTable As String
   Dim Fichier As String
   Dim Feuille As String
   strNomTable = "Temp_Importation_NotesExcel"
   Fichier = Me.sCheminFichier
   Feuille = Me.ListeClasseurs & "!"
   DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel9, strNomTable, Fichier, True, Feuille
End Sub
 
Sub DelierTableExcel()
    Dim strNomTable As String
    strNomTable = "Temp_Importation_NotesExcel"
    On Error Resume Next
    DoCmd.DeleteObject acTable, strNomTable
End Sub

La routine InserrerNotes() a également été légèrement modifiée pour mieux voir ce qui se passe.

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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
Sub InserrerNotes(vEcole As Long, vAnScol As String, vClas As String, vCompo As String)
    On Error Resume Next
    Dim dbs As DAO.Database
    Dim strSQL As String
    Dim strSQL_Eleve As String
    Dim rst As DAO.Recordset
    Dim rstEleve As DAO.Recordset
    Dim I As Integer
    Dim strNomTable As String
 
    'Variables de l'entête de la compo
    Dim stAnnee As String
    Dim vMle_El As Long
    Dim vClasse As String
    Dim vNatCompo As String
    Dim vStatut As String
    Dim vID_Etab As Long
    Dim N As Integer
 
    Dim sCoef As Integer
    Dim idAuto As Long
    Dim idComp As Long
    Dim NumMat As Long
    Dim LaNote As Single
 
    DoCmd.SetWarnings True
 
    strSQL_Eleve = "SELECT * FROM Req_Eleve_INSCRIT WHERE ID_ETABL_FREQ=" & vEcole & " AND ANNEE_SCOL ='" & vAnScol & "' AND ClasseArabe ='" & vClas & "'; "
 
    strNomTable = "Temp_Importation_NotesExcel"
 
    Set dbs = CurrentDb
 
    Set rstEleve = dbs.OpenRecordset(strSQL_Eleve)
    Debug.Print "rstEleve.RecordCount: "; rstEleve.RecordCount
 
    If Not rstEleve.EOF Then    'On boucle sur la liste des élèves de la classe
        rstEleve.MoveFirst
 
        Do While Not rstEleve.EOF
 
            DoEvents
            Debug.Print "------------- élève suivant ---------------"
 
            Me.lblMessage.Caption = "Traitement de l'élève n°" & rstEleve.Fields("Mleeleve") & "-" & rstEleve.Fields("nom") & " " & rstEleve.Fields("prenom")
            Me.lblMessage.Visible = True
 
            strSQL = "SELECT * FROM " & strNomTable & " WHERE mle_Eleve =" & rstEleve.Fields("Mleeleve") & " AND anscol='" & vAnScol & "' AND CompoArabe =" & vCompo & " AND ID_Etab =" & vEcole & ";"
            Debug.Print strSQL
            Set rst = dbs.OpenRecordset(strSQL)
            If rst Is Nothing Then
                MsgBox "rst is Nothing !", vbCritical, "rst vide"
                Exit Sub
            End If
            Debug.Print "Mleeleve: "; rstEleve.Fields("Mleeleve"),
            Debug.Print "rst.RecordCount: ";
            Debug.Print rst.RecordCount
 
            If Not rst.EOF Then
                N = 3
                rst.MoveFirst
                Do While Not rst.EOF
                    DoEvents
                   'Initialisation de l'entête de des notes [INFOS_COMPOSITION_ARABE] pour l'élève actif
                    idComp = NumeroAutoCompoArabes() + 1
                    stAnnee = vAnScol
                    vMle_El = rstEleve.Fields("Mleeleve")
                    vClasse = vClas
                    vNatCompo = vCompo
                    vStatut = "Classé"
                    vID_Etab = vEcole
 
                    If CompoDejaImportée_Ar(Me.txtANNEE, rstEleve("Mleeleve"), Me.txtCLASSE, Me.txtCOMPO, Me.Txt_ETABLISSEMENT) = False Then
 
                        strSQL = "INSERT INTO INFOS_COMPOSITION_ARABE (idCompoA, anscol, mle_Eleve, ClasseArabe, CompoArabe, Statut,ID_Etab) VALUES (" & idComp & ", '" & stAnnee & "', " & vMle_El & ", '" & vClasse & "', " & vNatCompo & ", '" & vStatut & "', " & vID_Etab & " );"
                        DoCmd.SetWarnings False
                        DoCmd.RunSQL strSQL
 
                        idAuto = NumeroAutoNotesArabes()
 
                        DoEvents
 
                        For I = 1 To Me.NbreMatiere
                            Debug.Print "i: "; I,
                            DoEvents
                            idAuto = idAuto + 1
                            NumMat = CLng(fIDM_parSENS_MATIERE_AR(rst.Fields(N + I).Name))
                            Debug.Print "N+I: "; N + I,
                            Debug.Print "NumMat: "; NumMat,
                            Debug.Print "Name: "; rst.Fields(N + I).Name
                            'Teste le contenu des cellules de notes
                            If IsNull(rst.Fields(N + I).Value) Then
                                LaNote = 0
                            Else
                                LaNote = CSng(rst.Fields(N + I).Value)
                            End If
 
                            sCoef = fCOEF_parMATIERE_AR(Me.txtANNEE, Me.txtCLASSE, fIDM_parSENS_MATIERE_AR(rst.Fields(N + I).Name), Me.txtCOMPO, Me.Txt_ETABLISSEMENT)
 
                            strSQL = "INSERT INTO NOTES_CLASSES_ARABES (idNotesArabe, idCA, matiereAr, coef,Ident_Etabl) VALUES (" & idAuto & ", " & idComp & ", " & NumMat & ", " & sCoef & ", " & vID_Etab & ");"
                            DoCmd.SetWarnings False
                            DoCmd.RunSQL strSQL
 
                            strSQL = "update NOTES_CLASSES_ARABES set NOTES_CLASSES_ARABES.Note =" & Replace(LaNote, ",", ".") & _
                            " where NOTES_CLASSES_ARABES.idNotesArabe =" & idAuto & ";"
                            DoCmd.SetWarnings False
                            DoCmd.RunSQL strSQL
                            strSQL = ""
                        Next I
                    Else
                        Me.lblMessage.Caption = "Notes déjà importées pour l'élève n°" & rstEleve.Fields("Mleeleve") & "-" & rstEleve.Fields("nom") & " " & rstEleve.Fields("prenom")
                        Me.lblMessage.Visible = True
                    End If
                    rst.MoveNext
                Loop
 
            End If
            rstEleve.MoveNext
        Loop
 
        MsgBox "Transfert effectué avec succès !"
        DoCmd.OpenForm "NOTES_DE_COMPOSITIONS", , , "[lstClasse]='" & Me.txtCLASSE & "' AND [lstAnnee]='" & Me.txtANNEE & "' AND [LstCompositions]=" & Me.txtCOMPO & "' AND [ID_ETABL_FREQ]=" & Me.Txt_ETABLISSEMENT & "", , , "PF"
        'DoCmd.OpenForm stDoc, , , "[ClasseFrancais]='" & Me.lstCLASSES_FR_DISPO & "' AND [ANNEE_SCOL]='" & Me.lstANNEE_SCOLAIRE & "'", , , "PF"
        DoCmd.Close acForm, "frmIMPORTER_NOTES_FichEXCEL_Ar"
        rst.Close
        rstEleve.Close
 
        Set rst = Nothing
        Set rstEleve = Nothing
 
        ' Supprime la Table temporaire.
 
        'dbs.Execute "DROP TABLE " & strNomTable & ";"
        DoCmd.SetWarnings True
    End If
End Sub

Bonne continuation.

[morobaboumar]

Bonsoir Membres du forum !
Espérant poursuivre cette discussion, je vous adresse les respects et remerciements
pour m'avoir donné satisfaction et résolu mon problème"Comment importer des données d'excel à Access ?".

2°) J'en profite pour savoir si ce même code peut être adapté à la création d'une table temporaire Access ?
Si oui, je vous prie de me récrire le code.
et

[morobaboumar]

Bonsoir Membres du forum !
Espérant poursuivre cette discussion, je vous adresse les respects et remerciements
pour m'avoir donné satisfaction et résolu mon problème"Comment importer des données d'excel à Access ?".

2°) J'en profite pour savoir si ce même code peut être adapté à la création d'une table temporaire Access ?
Si oui, je vous prie de me récrire le code.

3°) Je vous renvoie la pièce de mon programme afin que vous corrigiez les codes du formulaire "frmIMPORTER_NOTES_FichEXCEL_Fr" qui importe les notes des matières du français.
Voici ce que j'ai écrit à partir de la correction que vous m'avez envoyée

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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
 
Sub RemplirListeClasseurs()
On Error Resume Next
Dim App As Excel.Application
Dim Classeur As Excel.Worksheet
Dim strFichier As String            'Nom du fichier Excel
Dim I As Integer
Dim Nb As Integer
strFichier = Me.sCheminFichier
Set App = CreateObject("Excel.application")     'Ouverture d'Excel
App.Workbooks.Open strFichier                   'Ouverture du fichier à traiter
With App
    'Vidage de la liste
    Do While Me.ListeClasseurs.ListCount > 0
        DoEvents
        'Nb = Me.ListeClasseurs.ListCount
        'For i = 0 To Me.ListeClasseurs.ListCount - 1
            Me.ListeClasseurs.RemoveItem 0
            Me.ListeClasseurs.Requery
        'Next i
    Loop
 
    'Remplissage de la liste
    For Each Classeur In .Worksheets
    DoEvents
        Me.ListeClasseurs.AddItem Classeur.Name
    Next
End With
' ferme excel
App.Workbooks.Close
 
App.Quit
 
Set App = Nothing
Set Classeur = Nothing
End Sub
 
Sub CreerTableEtImporterDonnees()
    'On Error Resume Next
    Dim dbs As DAO.Database
    Dim strNomTable As String
    Dim strSQL As String
    Dim rst As DAO.Recordset
    Dim I As Integer
    Dim strChamp As String
    Dim Fichier As String
    Dim Feuille As String
    Dim N As Integer
    Dim strMsg As String
 
    strSQL = "SELECT * FROM MATIERE_CLASSE_FR WHERE annee_scol='" & Me.txtANNEE & "' AND classe_francais ='" & Me.txtCLASSE & "' AND NumCompoMCFr  =" & Me.txtCOMPO & " AND Identif_EtablisFR =" & Me.Txt_EtablissementFr & ";"
    'strNomTable = "Temp_" & Left(Me.txtCOMPO, 1) & Right(Me.txtCOMPO, 11) & "_" & Right(Me.txtANNEE, 4)
    strNomTable = "Temp_Importation_NotesExcel_Fr"
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset(strSQL)
    If TableExiste(strNomTable) Then
        SupprimerTable (strNomTable)
        'MsgBox "Elle existe"
    End If
 
    'On Error Resume Next
    strSQL = "CREATE TABLE  [" & strNomTable & "] (ID_Etab INTEGER ,anscol CHAR, CompoFRANCAIS INTEGER, ClasseFr CHAR, mle_Eleve INTEGER, NomEleve CHAR);"
    strSQL = "CREATE TABLE  [" & strNomTable & "] (Appreciation CHAR, Classement CHAR, MOYENNE REAL, TOTAL REAL);"
    DoCmd.SetWarnings False
    dbs.Execute strSQL
        If Not rst.EOF Then                      '
            rst.MoveLast
            Do While Not rst.BOF
               ' strChamp = fSENS_parID_Matiere_AR(rst.Fields("matiere_arabe"))
            'On Error Resume Next
                strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN [" & strChamp & "] REAL;"
                DoEvents
                dbs.Execute strSQL
 
                rst.MovePrevious
            Loop
        End If
 
        'On Error Resume Next
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN NomEleve CHAR;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN mle_Eleve INTEGER;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN ClasseFr CHAR;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN anscol CHAR;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN CompoFRANCAIS INTEGER;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN ID_Etab INTEGER;"
        DoEvents
        dbs.Execute strSQL
 
 
 Fichier = Me.sCheminFichier
 Feuille = Me.ListeClasseurs & "!"
 
    DoCmd.RunSQL "DELETE * FROM   " & strNomTable & ";"
 
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, strNomTable, Fichier, True, Feuille
 
    DoCmd.SetWarnings True
 
rst.Close
Set rst = Nothing
End Sub
 
Private Sub btn_Traitement_Click()
    DelierTableExcel                '--- surtout utile pendant mise au point !
    LierTableExcel                  '--- Lier à la feuille Excel sélectionnée
    InserrerNotes Me.Txt_EtablissementFr, Me.txtANNEE, Me.txtCLASSE, Me.txtCOMPO
    DelierTableExcel
End Sub
 Sub InserrerNotes(vEcole As Long, vAnScol As String, vClas As String, vCompo As String)
    On Error Resume Next
    Dim dbs As DAO.Database
    Dim strSQL As String
    Dim strSQL_Eleve As String
    Dim rst As DAO.Recordset
    Dim rstEleve As DAO.Recordset
    Dim I As Integer
    Dim strNomTable As String
 
    'Variables de l'entête de la compo
    Dim stAnnee As String
    Dim vMle_El As Long
    Dim vClasse As String
    Dim vNatCompo As String
    Dim vStatut As String
    Dim vID_Etab As Long
    Dim N As Integer
 
    Dim sCoef As Integer
    Dim idAuto As Long
    Dim idComp As Long
    Dim NumMat As Long
    Dim LaNote As Single
 
    DoCmd.SetWarnings True
 
    strSQL_Eleve = "SELECT * FROM Req_Eleve_INSCRIT WHERE ID_ETABL_FREQ=" & vEcole & " AND ANNEE_SCOL ='" & vAnScol & "' AND ClasseFrancais ='" & vClas & "'; "
 
    strNomTable = "Temp_Importation_NotesExcel_Fr"
 
    Set dbs = CurrentDb
 
    Set rstEleve = dbs.OpenRecordset(strSQL_Eleve)
    Debug.Print "rstEleve.RecordCount: "; rstEleve.RecordCount
 
    If Not rstEleve.EOF Then    'On boucle sur la liste des élèves de la classe
        rstEleve.MoveFirst
 
        Do While Not rstEleve.EOF
 
            DoEvents
            Debug.Print "------------- élève suivant ---------------"
 
            Me.lblMessage.Caption = "Traitement de l'élève n°" & rstEleve.Fields("Mleeleve") & "-" & rstEleve.Fields("nom") & " " & rstEleve.Fields("prenom")
            Me.lblMessage.Visible = True
 
            strSQL = "SELECT * FROM " & strNomTable & " WHERE mle_Eleve =" & rstEleve.Fields("Mleeleve") & " AND anscol='" & vAnScol & "' AND CompoFRANCAIS =" & vCompo & " AND ID_Etab =" & vEcole & ";"
            Debug.Print strSQL
            Set rst = dbs.OpenRecordset(strSQL)
            If rst Is Nothing Then
                MsgBox "rst is Nothing !", vbCritical, "rst vide"
                Exit Sub
            End If
            Debug.Print "Mleeleve: "; rstEleve.Fields("Mleeleve"),
            Debug.Print "rst.RecordCount: ";
            Debug.Print rst.RecordCount
 
            If Not rst.EOF Then
                N = 3
                rst.MoveFirst
                Do While Not rst.EOF
                    DoEvents
                   'Initialisation de l'entête de des notes [INFOS_COMPOSITION_FRANCAIS] pour l'élève actif
                    idComp = NumeroAutoCompoFrancais() + 1
                    stAnnee = vAnScol
                    vMle_El = rstEleve.Fields("Mleeleve")
                    vClasse = vClas
                    vNatCompo = vCompo
                    vStatut = "Classé"
                    vID_Etab = vEcole
 
                    If CompoDejaImportée_Fr(Me.txtANNEE, rstEleve("Mleeleve"), Me.txtCLASSE, Me.txtCOMPO, Me.Txt_EtablissementFr) = False Then
 
                        strSQL = "INSERT INTO INFOS_COMPOSITION_FRANCAIS (idCompoF, anscol, mle_Eleve, ClasseFr, CompoFRANCAIS, Statut, ID_Etab) VALUES (" & idComp & ", '" & stAnnee & "', " & vMle_El & ", '" & vClasse & "', " & vNatCompo & ", '" & vStatut & "', " & vID_Etab & " );"
                        DoCmd.SetWarnings False
                        DoCmd.RunSQL strSQL
 
                        idAuto = NumeroAutoNotesFrancais()
 
                        DoEvents
 
                       For I = 1 To Me.NbreMatiere
                            Debug.Print "i: "; I,
                           DoEvents
                           idAuto = idAuto + 1
                           ' NumMat = CLng(fIDM_parSENS_MATIERE_AR(rst.Fields(N + I).Name))
                            Debug.Print "N+I: "; N + I,
                           ' Debug.Print "NumMat: "; NumMat,
                           ' Debug.Print "Name: "; rst.Fields(N + I).Name
                           ' 'Teste le contenu des cellules de notes
                          '  If IsNull(rst.Fields(N + I).Value) Then
                                'LaNote = 0
                           ' Else
                                'LaNote = CSng(rst.Fields(N + I).Value)
                          '  End If
 For I = 1 To Me.NbreMatiere
                            DoEvents
                            idAuto = idAuto + 1
                            NumMat = CLng(fIDM_parMATIERE(rst.Fields(N + I).Name))
 
                            'Teste le contenu des cellules de notes
                            If IsNull(rst.Fields(N + I).Value) Then
                            LaNote = 0
                            Else
                            LaNote = CSng(rst.Fields(N + I).Value)
                            End If
                            sCoef = fCOEF_parMATIERE(Me.txtANNEE, Me.txtCLASSE, fIDM_parMATIERE(rst.Fields(N + I).Name), Me.txtCOMPO, Me.Txt_EtablissementFr)
 
                            strSQL = "INSERT INTO NOTES_CLASSES_FRANCAIS (idNotesArabe, idCF, matiereFr, coef, Ident_Etabl_FR) VALUES (" & idAuto & ", " & idComp & ", " & NumMat & ", " & sCoef & ", " & vID_Etab & ");"
                            DoCmd.SetWarnings False
                            DoCmd.RunSQL strSQL
 
                            strSQL = "update NOTES_CLASSES_FRANCAIS set NOTES_CLASSES_FRANCAIS.Note =" & Replace(LaNote, ",", ".") & _
                            " NOTES_CLASSES_FRANCAIS.idNotesFrancais =" & idAuto & ";"
                            DoCmd.SetWarnings False
                            DoCmd.RunSQL strSQL
                            strSQL = ""
                        Next I
                    Else
                        Me.lblMessage.Caption = "Notes déjà importées pour l'élève n°" & rstEleve.Fields("Mleeleve") & "-" & rstEleve.Fields("nom") & " " & rstEleve.Fields("prenom")
                        Me.lblMessage.Visible = True
                    End If
                    rst.MoveNext
                Loop
 
            End If
            rstEleve.MoveNext
        Loop
 
        MsgBox "Transfert effectué avec succès !"
        DoCmd.OpenForm " NOTES DE COMPOSITIONS FR", , , "[lstClasse]='" & Me.txtCLASSE & "' AND [lstAnnee]='" & Me.txtANNEE & "' AND [LstCompositions]=" & Me.txtCOMPO & "' AND [ID_ETABL_FREQ]=" & Me.Txt_EtablissementFr & "", , , "PF"
        'DoCmd.OpenForm stDoc, , , "[ClasseFrancais]='" & Me.lstCLASSES_FR_DISPO & "' AND [ANNEE_SCOL]='" & Me.lstANNEE_SCOLAIRE & "'", , , "PF"
        DoCmd.Close acForm, "frmIMPORTER_NOTES_FichEXCEL_Fr"
        rst.Close
        rstEleve.Close
 
        Set rst = Nothing
        Set rstEleve = Nothing
 
        ' Supprime la Table temporaire.
 
        dbs.Execute "DROP TABLE " & strNomTable & ";"
        DoCmd.SetWarnings True
    End If
End Sub
 
Sub LierTableExcel()
   Dim strNomTable As String
   Dim Fichier As String
   Dim Feuille As String
   strNomTable = " Temp_Importation_NotesExcel_Fr "
   Fichier = Me.sCheminFichier
   Feuille = Me.ListeClasseurs & "!"
   DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel9, strNomTable, Fichier, True, Feuille
End Sub
 
Sub DelierTableExcel()
    Dim strNomTable As String
    strNomTable = " Temp_Importation_NotesExcel_Fr"
    On Error Resume Next
    DoCmd.DeleteObject acTable, strNomTable
End Sub

et

[EricDgn]

Bonjour,

Créer des tables temporaires n'est vraiment pas une bonne idée. Le mieux est de piocher les données utiles dans la feuille Excel liée pour les rentrer dans les tables définitives.

Pour l'importation des données Fr, c'est un copier-coller, avec quelques petites modifications, de l'importation Ar, sans utiliser de table tampon.

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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
Sub InserrerNotes(vEcole As Long, vAnScol As String, vClas As String, vCompo As String)
    On Error Resume Next
    Dim dbs As DAO.Database
    Dim strSQL As String
    Dim strSQL_Eleve As String
    Dim rst As DAO.Recordset
    Dim rstEleve As DAO.Recordset
    Dim I As Integer
    Dim strNomTable As String
 
    'Variables de l'entête de la compo
    Dim stAnnee As String
    Dim vMle_El As Long
    Dim vClasse As String
    Dim vNatCompo As String
    Dim vStatut As String
    Dim vID_Etab As Long
    Dim N As Integer
 
    Dim sCoef As Integer
    Dim idAuto As Long
    Dim idComp As Long
    Dim NumMat As Long
    Dim LaNote As Single
 
    strSQL_Eleve = "SELECT * FROM Req_Eleve_INSCRIT" & _
                   " WHERE ID_ETABL_FREQ=" & vEcole & _
                   " AND ANNEE_SCOL ='" & vAnScol & "'" & _
                   " AND ClasseFrancais ='" & vClas & "';"
    strNomTable = "Temp_Importation_NotesExcel"
    Set dbs = CurrentDb
    Set rstEleve = dbs.OpenRecordset(strSQL_Eleve)
    If rstEleve Is Nothing Then Stop                            '--- rst vide
    Debug.Print "rstEleve.RecordCount: "; rstEleve.RecordCount
    If Not rstEleve.EOF Then
        rstEleve.MoveFirst
        Do While Not rstEleve.EOF   '--- boucle sur la liste des élèves de la classe
            DoEvents
            Debug.Print "------------- élève suivant ---------------"
            Me.lblMessage.Caption = "Traitement de  l'élève " & rstEleve.Fields("NPrenomsEleves")
            strSQL = "SELECT * FROM " & strNomTable & _
                     " WHERE mle_Eleve =" & rstEleve.Fields("Mleeleve") & _
                     " AND anscol='" & vAnScol & "'" & _
                     " AND CompoFRANCAIS =" & vCompo & _
                     " AND Ident_Etabl_FR =" & vEcole & ";"
            Debug.Print "Fichier notes arabe"
            Debug.Print strSQL
            Set rst = dbs.OpenRecordset(strSQL)
            If rst Is Nothing Then
                MsgBox "La reprise des notes depuis le fichier Excel a échoué !", vbCritical, "rst vide"
                Exit Sub                                                '=== EXIT SUB ===
            End If
            Debug.Print "Mleeleve: "; rstEleve.Fields("Mleeleve"),
            Debug.Print "rst.RecordCount: ";
            Debug.Print rst.RecordCount
            If Not rst.EOF Then
                N = 3
                rst.MoveFirst
                Do While Not rst.EOF
                    DoEvents
                   'Initialisation de l'entête des notes [INFOS_COMPOSITION_ARABE] pour l'élève actif
                    idComp = DMax("idCompoF", "INFOS_COMPOSITION_FRANCAIS") + 1
                    stAnnee = vAnScol
                    vMle_El = rstEleve.Fields("Mleeleve")
                    vClasse = vClas
                    vNatCompo = vCompo
                    vStatut = "Classé"
                    vID_Etab = vEcole
                    If CompoDejaImportée_Fr(Me.txtANNEE, rstEleve("Mleeleve"), Me.txtCLASSE, Me.txtCOMPO, Me.Txt_EtablissementFr) = False Then
                        strSQL = "INSERT INTO INFOS_COMPOSITION_FRANCAIS " & _
                                " (idCompoF, anscol, mle_Eleve, ClasseFr, CompoFRANCAIS, Statut, ID_Etab)" & _
                                " VALUES (" & _
                                idComp & ", '" & stAnnee & "', " & vMle_El & ", '" & vClasse & "', " & _
                                vNatCompo & ", '" & vStatut & "', " & vID_Etab & " );"
                        DoSQL strSQL
                        idAuto = NumeroAutoNotesFrancais()
                        DoEvents
                        For I = 1 To Me.NbreMatiere
                            Debug.Print "i: "; I,
                            DoEvents
                            idAuto = idAuto + 1
                            NumMat = CLng(fIDM_parMATIERE(rst.Fields(N + I).Name))
                            Debug.Print "N+I: "; N + I,
                            Debug.Print "NumMat: "; NumMat,
                            Debug.Print "Name: "; rst.Fields(N + I).Name
                            '--- Teste le contenu des cellules de notes
                            If IsNull(rst.Fields(N + I).Value) Then
                                LaNote = 0
                            Else
                                LaNote = CSng(rst.Fields(N + I).Value)
                            End If
                            sCoef = fCOEF_parMATIERE(Me.txtANNEE, Me.txtCLASSE, fIDM_parMATIERE(rst.Fields(N + I).Name), Me.txtCOMPO, Me.Txt_EtablissementFr)
                            strSQL = "INSERT INTO NOTES_CLASSES_FRANCAIS" & _
                                     " (idNotesFrancais, idCF, matiereFr, coef, Ident_Etabl_FR, NoteFr)" & _
                                     " VALUES (" & _
                                     idAuto & ", " & idComp & ", " & NumMat & ", " & sCoef & ", " & _
                                     vID_Etab & ", " & Replace(LaNote, ",", ".") & ");"
                            DoSQL strSQL
                        Next I
                    Else
                        Me.lblMessage.Caption = "Notes déjà importées pour l'élève " & rstEleve.Fields("NPrenomsEleves")
                    End If
                    rst.MoveNext
                Loop
            End If
            rstEleve.MoveNext
        Loop
        Me.lblMessage.Caption = "Transfert effectué avec succès !"
        MsgBox "Transfert effectué avec succès !"
        'DoCmd.OpenForm "NOTES DE COMPOSITIONS FR", , , "[lstClasse]='" & Me.txtCLASSE & "' AND [lstAnnee]='" & Me.txtANNEE & "' AND [LstCompositions]=" & Me.txtCOMPO & " AND [ID_ETABL_FREQ]=" & Me.Txt_ETABLISSEMENT & "", , , "PF"
        rst.Close
        rstEleve.Close
        Set rst = Nothing
        Set rstEleve = Nothing
    End If
End Sub

Je n'ai pas vraiment compris la structuration de la base de données, aussi il faudra voir si la récupération correspond bien à ce qui est prévu!

Bonne continuation.

[morobaboumar]

Salut Membres du forum !
Les derniers codes que j'ai reçus sont bons mais n’introduisent pas les notes dans les tables "NOTES_CLASSES_ARABES" et "NOTES_CLASSES_FRANCAIS". Par contre les infos des tables "INFOS_COMPOSITION_ARABE" et "INFOS_COMPOSITION_FRANCAIS" arrivent à destination.
Voici comment mon programme traitant les notes de compositions est conçu. Après l'insertion des info de la table infos composition arabe, les données doivent être inserrer gans la table notes classe arabes sachant que l'arabe s'écrit de la droite vers la gauche (voir la disposition Fiche Excel de Notes d'arabe. Et le Français de la gauche vers la droite.
Pour écrire les codes nous devons tenir compte de toutes ces dispositions. En effet, le dernier code que vous m'avez fait parvenir réussit à inserrer les informations de la table "INFOS_COMPOSITION_ARABE" mais les notes de la table "NOTES_CLASSES_ARABES" n'y arrivent pas. Veuillez m'aider à résoudre cette difficulté.
Espérant trouver une suite favorable, encore une fois
Merci infiniment
Très cordialement

[EricDgn]

Bonjour,

J'ai effectué le test suivant:

a) supprimer tous les enregistrements contenus dans les 4 tables NOTES_CLASSES_ARABES, NOTES_CLASSES_FRANCAIS, INFOS_COMPOSITION_ARABE et INFOS COMPOSITION_FRANCAIS;

b) ouvrir le formulaire f_IMPORTER_NOTESEXCEL_Ar et sélectionner le fichier Notes CP2 A_Arabe - 2016-2017.xls, choisir 'Notes du 1erTrimestre 2016-2017 et complété les autres champs de ce formulaire de cette façon:

c) cliquer sur le bouton 'Lancer le traitement'

Cela a donné en résultat:
- 32 enregistrements ajoutés dans la table INFOS_COMPOSITION_ARABE
- 256 enregistrements ajoutés dans la table NOTES_CLASSES_ARABE

Il ne semble pas y avoir de problème lié aux sens d'écriture.
Cordialement.

[morobaboumar]

Bonjour !
Après avoir télécharger la pièce joint du fichier corrigé, vraiment l'importation marche des deux côtés.
Mais un autre souci demeure: la commande de calcule des moyennes ne renvoie plus ni les totaux de points ni les moyennes qui se trouvent toujours à 00,00.
Je vous prie de me donner la solution.

[EricDgn]

Bonjour,

Voici le code pour que les notes soient également reprises du fichier Excel.
Ceci est pour le formulaire f_IMPORTER_NOTES_EXCEL_Ar:

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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
Sub InserrerNotes(vEcole As Long, vAnScol As String, vClas As String, vCompo As String)
    On Error Resume Next
    Dim dbs As DAO.Database
    Dim strSQL As String
    Dim strSQL_Eleve As String
    Dim rst As DAO.Recordset
    Dim rstEleve As DAO.Recordset
    Dim I As Integer
    Dim strNomTable As String
 
    'Variables de l'entête de la compo
    Dim stAnnee As String
    Dim vMle_El As Long
    Dim vClasse As String
    Dim vNatCompo As String
    Dim vStatut As String
    Dim vID_Etab As Long
    Dim N As Integer
 
    Dim sCoef As Integer
    Dim idAuto As Long
    Dim idComp As Long
    Dim NumMat As Long
    Dim LaNote As String        '--- évite les problèmes de virgule décimale avec Excel
 
    strSQL_Eleve = "SELECT * FROM Req_Eleve_INSCRIT" & _
                   " WHERE ID_ETABL_FREQ=" & vEcole & _
                   " AND ANNEE_SCOL ='" & vAnScol & "'" & _
                   " AND ClasseArabe ='" & vClas & "';"
    strNomTable = "Temp_Importation_NotesExcel"
    Set dbs = CurrentDb
    Set rstEleve = dbs.OpenRecordset(strSQL_Eleve)
    If rstEleve Is Nothing Then Stop                            '--- rst vide
    Debug.Print "rstEleve.RecordCount: "; rstEleve.RecordCount
    If Not rstEleve.EOF Then
        rstEleve.MoveFirst
        Do While Not rstEleve.EOF   '--- boucle sur la liste des élèves de la classe
            DoEvents
            Debug.Print "------------- élève suivant ---------------"
            Me.lblMessage.Caption = "Traitement de  l'élève " & rstEleve.Fields("NPrenomsEleves")
            strSQL = "SELECT * FROM " & strNomTable & _
                     " WHERE mle_Eleve =" & rstEleve.Fields("Mleeleve") & _
                     " AND anscol='" & vAnScol & "'" & _
                     " AND CompoArabe =" & vCompo & _
                     " AND ID_Etab =" & vEcole & ";"
            Debug.Print "Fichier notes arabe"
            Debug.Print strSQL
            Set rst = dbs.OpenRecordset(strSQL)
            If rst Is Nothing Then
                MsgBox "La reprise des notes depuis le fichier Excel a échoué !", vbCritical, "rst vide"
                Exit Sub                                                '=== EXIT SUB ===
            End If
            Debug.Print "Mleeleve: "; rstEleve.Fields("Mleeleve"),
            Debug.Print "rst.RecordCount: ";
            Debug.Print rst.RecordCount
            If Not rst.EOF Then
                N = 3
                rst.MoveFirst
                Do While Not rst.EOF
                    DoEvents
                   'Initialisation de l'entête des notes [INFOS_COMPOSITION_ARABE] pour l'élève actif
                    'idComp = NumeroAutoCompoArabes() + 1
                    idComp = DMax("idCompoA", "INFOS_COMPOSITION_ARABE") + 1
                    stAnnee = vAnScol
                    vMle_El = rstEleve.Fields("Mleeleve")
                    vClasse = vClas
                    vNatCompo = vCompo
                    vStatut = "Classé"
                    vID_Etab = vEcole
                    If CompoDejaImportée_Ar(Me.txtANNEE, rstEleve("Mleeleve"), Me.txtCLASSE, Me.txtCOMPO, Me.Txt_ETABLISSEMENT) = False Then
                        strSQL = "INSERT INTO INFOS_COMPOSITION_ARABE " & _
                                " (idCompoA, anscol, mle_Eleve, ClasseArabe, CompoArabe, Statut, ID_Etab, MoyenneCompo, Total_Notes)" & _
                                " VALUES (" & _
                                idComp & ", '" & stAnnee & "', " & vMle_El & ", '" & vClasse & "', " & _
                                vNatCompo & ", '" & vStatut & "', " & vID_Etab & ", " & _
                                Replace(rst!Moyenne, ",", ".") & ", " & Replace(rst!Total, ",", ".") & ");"
                                '--- replace() à cause reprise d'Excel avec virgule décimale
                        DoSQL strSQL
                        idAuto = NumeroAutoNotesArabes()
                        For I = 1 To Me.NbreMatiere
                            Debug.Print "i: "; I,
                            idAuto = idAuto + 1
                            NumMat = CLng(fIDM_parSENS_MATIERE_AR(rst.Fields(N + I).Name))
                            LaNote = Replace(rst.Fields(N + I), ",", ".")
                            Debug.Print "N+I: "; N + I,
                            Debug.Print "NumMat: "; NumMat,
                            Debug.Print "Name: "; rst.Fields(N + I).Name,
                            Debug.Print "LaNote: "; LaNote,
                            Debug.Print
                            sCoef = fCOEF_parMATIERE_AR(Me.txtANNEE, Me.txtCLASSE, fIDM_parSENS_MATIERE_AR(rst.Fields(N + I).Name), Me.txtCOMPO, Me.Txt_ETABLISSEMENT)
                            strSQL = "INSERT INTO NOTES_CLASSES_ARABES" & _
                                     " (idNotesArabe, idCA, matiereAr, coef, Ident_Etabl, NoteAr)" & _
                                     " VALUES (" & _
                                     idAuto & ", " & idComp & ", " & NumMat & ", " & sCoef & ", " & _
                                     vID_Etab & ", " & LaNote & ");"
                            DoSQL strSQL
                        Next I
                    Else
                        Me.lblMessage.Caption = "Notes déjà importées pour l'élève " & rstEleve.Fields("NPrenomsEleves")
                    End If
                    rst.MoveNext
                Loop
            End If
            rstEleve.MoveNext
        Loop
        Me.lblMessage.Caption = "Transfert effectué avec succès !"
        MsgBox "Transfert effectué avec succès !"
        'DoCmd.OpenForm "NOTES DE COMPOSITIONS", , , "[lstClasse]='" & Me.txtCLASSE & "' AND [lstAnnee]='" & Me.txtANNEE & "' AND [LstCompositions]=" & Me.txtCOMPO & " AND [ID_ETABL_FREQ]=" & Me.Txt_ETABLISSEMENT & "", , , "PF"
        rst.Close
        rstEleve.Close
        Set rst = Nothing
        Set rstEleve = Nothing
    End If
End Sub

Même genre de corrections pour le formulaire f_IMPORTER_NOTES_EXCEL_Fr

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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
Sub InserrerNotes(vEcole As Long, vAnScol As String, vClas As String, vCompo As String)
    On Error Resume Next
    Dim dbs As DAO.Database
    Dim strSQL As String
    Dim strSQL_Eleve As String
    Dim rst As DAO.Recordset
    Dim rstEleve As DAO.Recordset
    Dim I As Integer
    Dim strNomTable As String
 
    'Variables de l'entête de la compo
    Dim stAnnee As String
    Dim vMle_El As Long
    Dim vClasse As String
    Dim vNatCompo As String
    Dim vStatut As String
    Dim vID_Etab As Long
    Dim N As Integer
 
    Dim sCoef As Integer
    Dim idAuto As Long
    Dim idComp As Long
    Dim NumMat As Long
    Dim LaNote As String        '--- évite les problèmes de virgule décimale avec Excel
 
    strSQL_Eleve = "SELECT * FROM Req_Eleve_INSCRIT" & _
                   " WHERE ID_ETABL_FREQ=" & vEcole & _
                   " AND ANNEE_SCOL ='" & vAnScol & "'" & _
                   " AND ClasseFrancais ='" & vClas & "';"
    strNomTable = "Temp_Importation_NotesExcel"
    Set dbs = CurrentDb
    Set rstEleve = dbs.OpenRecordset(strSQL_Eleve)
    If rstEleve Is Nothing Then Stop                            '--- rst vide
    Debug.Print "rstEleve.RecordCount: "; rstEleve.RecordCount
    If Not rstEleve.EOF Then
        rstEleve.MoveFirst
        Do While Not rstEleve.EOF   '--- boucle sur la liste des élèves de la classe
            DoEvents
            Debug.Print "------------- élève suivant ---------------"
            Me.lblMessage.Caption = "Traitement de  l'élève " & rstEleve.Fields("NPrenomsEleves")
            strSQL = "SELECT * FROM " & strNomTable & _
                     " WHERE mle_Eleve =" & rstEleve.Fields("Mleeleve") & _
                     " AND anscol='" & vAnScol & "'" & _
                     " AND CompoFRANCAIS =" & vCompo & _
                     " AND Ident_Etabl_FR =" & vEcole & ";"
            Debug.Print "Fichier notes arabe"
            Debug.Print strSQL
            Set rst = dbs.OpenRecordset(strSQL)
            If rst Is Nothing Then
                MsgBox "La reprise des notes depuis le fichier Excel a échoué !", vbCritical, "rst vide"
                Exit Sub                                                '=== EXIT SUB ===
            End If
            Debug.Print "Mleeleve: "; rstEleve.Fields("Mleeleve"),
            Debug.Print "rst.RecordCount: ";
            Debug.Print rst.RecordCount
            If Not rst.EOF Then
                N = 3
                rst.MoveFirst
                Do While Not rst.EOF
                    DoEvents
                   'Initialisation de l'entête des notes [INFOS_COMPOSITION_ARABE] pour l'élève actif
                    idComp = DMax("idCompoF", "INFOS_COMPOSITION_FRANCAIS") + 1
                    stAnnee = vAnScol
                    vMle_El = rstEleve.Fields("Mleeleve")
                    vClasse = vClas
                    vNatCompo = vCompo
                    vStatut = "Classé"
                    vID_Etab = vEcole
                    If CompoDejaImportée_Fr(Me.txtANNEE, rstEleve("Mleeleve"), Me.txtCLASSE, Me.txtCOMPO, Me.Txt_EtablissementFr) = False Then
                        strSQL = "INSERT INTO INFOS_COMPOSITION_FRANCAIS " & _
                                " (idCompoF, anscol, mle_Eleve, ClasseFr, CompoFRANCAIS, Statut, ID_Etab, MoyenneCompo, Total_Notes)" & _
                                " VALUES (" & _
                                idComp & ", '" & stAnnee & "', " & vMle_El & ", '" & vClasse & "', " & _
                                vNatCompo & ", '" & vStatut & "', " & vID_Etab & ", " & _
                                Replace(rst!Moyenne, ",", ".") & ", " & Replace(rst!Total, ",", ".") & ");"
                        DoSQL strSQL
                        idAuto = NumeroAutoNotesFrancais()
                        DoEvents
                        For I = 1 To Me.NbreMatiere
                            Debug.Print "i: "; I,
                            idAuto = idAuto + 1
                            NumMat = CLng(fIDM_parMATIERE(rst.Fields(N + I).Name))
                            LaNote = Replace(rst.Fields(N + I), ",", ".")
                            Debug.Print "N+I: "; N + I,
                            Debug.Print "NumMat: "; NumMat,
                            Debug.Print "Name: "; rst.Fields(N + I).Name,
                            Debug.Print "LaNote: "; LaNote,
                            Debug.Print
                            sCoef = fCOEF_parMATIERE(Me.txtANNEE, Me.txtCLASSE, fIDM_parMATIERE(rst.Fields(N + I).Name), Me.txtCOMPO, Me.Txt_EtablissementFr)
                            strSQL = "INSERT INTO NOTES_CLASSES_FRANCAIS" & _
                                     " (idNotesFrancais, idCF, matiereFr, coef, Ident_Etabl_FR, NoteFr)" & _
                                     " VALUES (" & _
                                     idAuto & ", " & idComp & ", " & NumMat & ", " & sCoef & ", " & _
                                     vID_Etab & ", " & LaNote & ");"
                            DoSQL strSQL
                        Next I
                    Else
                        Me.lblMessage.Caption = "Notes déjà importées pour l'élève " & rstEleve.Fields("NPrenomsEleves")
                    End If
                    rst.MoveNext
                Loop
            End If
            rstEleve.MoveNext
        Loop
        Me.lblMessage.Caption = "Transfert effectué avec succès !"
        MsgBox "Transfert effectué avec succès !"
        'DoCmd.OpenForm "NOTES DE COMPOSITIONS FR", , , "[lstClasse]='" & Me.txtCLASSE & "' AND [lstAnnee]='" & Me.txtANNEE & "' AND [LstCompositions]=" & Me.txtCOMPO & " AND [ID_ETABL_FREQ]=" & Me.Txt_ETABLISSEMENT & "", , , "PF"
        rst.Close
        rstEleve.Close
        Set rst = Nothing
        Set rstEleve = Nothing
    End If
End Sub

Bonne continuation.

[morobaboumar]

Salut Membres du Forum!
Veuillez revérifier ce code:
Même genre de corrections pour le formulaire f_IMPORTER_NOTES_EXCEL_Fr
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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
Sub InserrerNotes(vEcole As Long, vAnScol As String, vClas As String, vCompo As String)
    On Error Resume Next
    Dim dbs As DAO.Database
    Dim strSQL As String
    Dim strSQL_Eleve As String
    Dim rst As DAO.Recordset
    Dim rstEleve As DAO.Recordset
    Dim I As Integer
    Dim strNomTable As String
 
    'Variables de l'entête de la compo
    Dim stAnnee As String
    Dim vMle_El As Long
    Dim vClasse As String
    Dim vNatCompo As String
    Dim vStatut As String
    Dim vID_Etab As Long
    Dim N As Integer
 
    Dim sCoef As Integer
    Dim idAuto As Long
    Dim idComp As Long
    Dim NumMat As Long
    Dim LaNote As String        '--- évite les problèmes de virgule décimale avec Excel
 
    strSQL_Eleve = "SELECT * FROM Req_Eleve_INSCRIT" & _
                   " WHERE ID_ETABL_FREQ=" & vEcole & _
                   " AND ANNEE_SCOL ='" & vAnScol & "'" & _
                   " AND ClasseFrancais ='" & vClas & "';"
    strNomTable = "Temp_Importation_NotesExcel"
    Set dbs = CurrentDb
    Set rstEleve = dbs.OpenRecordset(strSQL_Eleve)
    If rstEleve Is Nothing Then Stop                            '--- rst vide
    Debug.Print "rstEleve.RecordCount: "; rstEleve.RecordCount
    If Not rstEleve.EOF Then
        rstEleve.MoveFirst
        Do While Not rstEleve.EOF   '--- boucle sur la liste des élèves de la classe
            DoEvents
            Debug.Print "------------- élève suivant ---------------"
            Me.lblMessage.Caption = "Traitement de  l'élève " & rstEleve.Fields("NPrenomsEleves")
            strSQL = "SELECT * FROM " & strNomTable & _
                     " WHERE mle_Eleve =" & rstEleve.Fields("Mleeleve") & _
                     " AND anscol='" & vAnScol & "'" & _
                     " AND CompoFRANCAIS =" & vCompo & _
                     " AND Ident_Etabl_FR =" & vEcole & ";"
            Debug.Print "Fichier notes arabe"
            Debug.Print strSQL
            Set rst = dbs.OpenRecordset(strSQL)
            If rst Is Nothing Then
                MsgBox "La reprise des notes depuis le fichier Excel a échoué !", vbCritical, "rst vide"
                Exit Sub                                                '=== EXIT SUB ===
            End If
            Debug.Print "Mleeleve: "; rstEleve.Fields("Mleeleve"),
            Debug.Print "rst.RecordCount: ";
            Debug.Print rst.RecordCount
            If Not rst.EOF Then
                N = 3
                rst.MoveFirst
                Do While Not rst.EOF
                    DoEvents
                   'Initialisation de l'entête des notes [INFOS_COMPOSITION_ARABE] pour l'élève actif
                    idComp = DMax("idCompoF", "INFOS_COMPOSITION_FRANCAIS") + 1
                    stAnnee = vAnScol
                    vMle_El = rstEleve.Fields("Mleeleve")
                    vClasse = vClas
                    vNatCompo = vCompo
                    vStatut = "Classé"
                    vID_Etab = vEcole
                    If CompoDejaImportée_Fr(Me.txtANNEE, rstEleve("Mleeleve"), Me.txtCLASSE, Me.txtCOMPO, Me.Txt_EtablissementFr) = False Then
                        strSQL = "INSERT INTO INFOS_COMPOSITION_FRANCAIS " & _
                                " (idCompoF, anscol, mle_Eleve, ClasseFr, CompoFRANCAIS, Statut, ID_Etab, MoyenneCompo, Total_Notes)" & _
                                " VALUES (" & _
                                idComp & ", '" & stAnnee & "', " & vMle_El & ", '" & vClasse & "', " & _
                                vNatCompo & ", '" & vStatut & "', " & vID_Etab & ", " & _
                                Replace(rst!Moyenne, ",", ".") & ", " & Replace(rst!Total, ",", ".") & ");"
                        DoSQL strSQL
                        idAuto = NumeroAutoNotesFrancais()
                        DoEvents
                        For I = 1 To Me.NbreMatiere
                            Debug.Print "i: "; I,
                            idAuto = idAuto + 1
                            NumMat = CLng(fIDM_parMATIERE(rst.Fields(N + I).Name))
                            LaNote = Replace(rst.Fields(N + I), ",", ".")
                            Debug.Print "N+I: "; N + I,
                            Debug.Print "NumMat: "; NumMat,
                            Debug.Print "Name: "; rst.Fields(N + I).Name,
                            Debug.Print "LaNote: "; LaNote,
                            Debug.Print
                            sCoef = fCOEF_parMATIERE(Me.txtANNEE, Me.txtCLASSE, fIDM_parMATIERE(rst.Fields(N + I).Name), Me.txtCOMPO, Me.Txt_EtablissementFr)
                            strSQL = "INSERT INTO NOTES_CLASSES_FRANCAIS" & _
                                     " (idNotesFrancais, idCF, matiereFr, coef, Ident_Etabl_FR, NoteFr)" & _
                                     " VALUES (" & _
                                     idAuto & ", " & idComp & ", " & NumMat & ", " & sCoef & ", " & _
                                     vID_Etab & ", " & LaNote & ");"
                            DoSQL strSQL
                        Next I
                    Else
                        Me.lblMessage.Caption = "Notes déjà importées pour l'élève " & rstEleve.Fields("NPrenomsEleves")
                    End If
                    rst.MoveNext
                Loop
            End If
            rstEleve.MoveNext
        Loop
        Me.lblMessage.Caption = "Transfert effectué avec succès !"
        MsgBox "Transfert effectué avec succès !"
        'DoCmd.OpenForm "NOTES DE COMPOSITIONS FR", , , "[lstClasse]='" & Me.txtCLASSE & "' AND [lstAnnee]='" & Me.txtANNEE & "' AND [LstCompositions]=" & Me.txtCOMPO & " AND [ID_ETABL_FREQ]=" & Me.Txt_ETABLISSEMENT & "", , , "PF"
        rst.Close
        rstEleve.Close
        Set rst = Nothing
        Set rstEleve = Nothing
    End If
End Sub

.
Il n'introduit pas les données dans la table "INFOS_COMPOSITION_FRANCAIS", en plus le nombre de matières introduit dans la table "NOTES_CLASSES_FRANCAIS" est inférieur à celui se trouvant sur la feuille de Notes Excel.

Par contre celui de l'arabe marche.
Voir la pièce jointe.
Merci infiniment