1. #1
    Nouveau membre du Club Avatar de morobaboumar
    Inscrit en
    septembre 2009
    Messages
    114
    Détails du profil
    Informations forums :
    Inscription : septembre 2009
    Messages : 114
    Points : 39
    Points
    39

    Par défaut Comment importer des données d'excel à Access ?

    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
    Fichiers attachés Fichiers attachés
    Le savoir est la lumière de l'esprit
    Le chemin de la réussite

    Qui cherche positivement trouve
    Tout ce qui brille n'est pas l'or ou diamant
    Mais l'or et le diamant se trouvent avec sagesse, intelligence et effort

  2. #2
    Membre éprouvé
    Homme Profil pro
    retraité
    Inscrit en
    juin 2012
    Messages
    614
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : retraité
    Secteur : Associations - ONG

    Informations forums :
    Inscription : juin 2012
    Messages : 614
    Points : 987
    Points
    987

    Par défaut

    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.

  3. #3
    Expert confirmé
    Avatar de dysorthographie
    Homme Profil pro
    Ingénieur développement logiciels
    Inscrit en
    septembre 2016
    Messages
    2 459
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Charente Maritime (Poitou Charente)

    Informations professionnelles :
    Activité : Ingénieur développement logiciels
    Secteur : Industrie

    Informations forums :
    Inscription : septembre 2016
    Messages : 2 459
    Points : 4 200
    Points
    4 200
    Billets dans le blog
    1

    Par défaut

    Bonsoir,
    Il faut considérer Excel comme une base de données!
    https://mon-partage.fr/f/LoCWKVjq/
    Il dit non avec la tête
    mais il dit oui avec le coeur
    il dit oui à ce qu’il aime
    il dit non au professeur {Jacques PRÉVERT}

  4. #4
    Nouveau membre du Club Avatar de morobaboumar
    Inscrit en
    septembre 2009
    Messages
    114
    Détails du profil
    Informations forums :
    Inscription : septembre 2009
    Messages : 114
    Points : 39
    Points
    39

    Par défaut Comment importer des données d'excel à Access ?

    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
    Images attachées Images attachées  
    Fichiers attachés Fichiers attachés
    Le savoir est la lumière de l'esprit
    Le chemin de la réussite

    Qui cherche positivement trouve
    Tout ce qui brille n'est pas l'or ou diamant
    Mais l'or et le diamant se trouvent avec sagesse, intelligence et effort

  5. #5
    Membre éprouvé
    Homme Profil pro
    retraité
    Inscrit en
    juin 2012
    Messages
    614
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : retraité
    Secteur : Associations - ONG

    Informations forums :
    Inscription : juin 2012
    Messages : 614
    Points : 987
    Points
    987

    Par défaut

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

  6. #6
    Nouveau membre du Club Avatar de morobaboumar
    Inscrit en
    septembre 2009
    Messages
    114
    Détails du profil
    Informations forums :
    Inscription : septembre 2009
    Messages : 114
    Points : 39
    Points
    39

    Par défaut Comment adapter acLink à mon code ?

    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.
    Le savoir est la lumière de l'esprit
    Le chemin de la réussite

    Qui cherche positivement trouve
    Tout ce qui brille n'est pas l'or ou diamant
    Mais l'or et le diamant se trouvent avec sagesse, intelligence et effort

  7. #7
    Expert confirmé
    Avatar de dysorthographie
    Homme Profil pro
    Ingénieur développement logiciels
    Inscrit en
    septembre 2016
    Messages
    2 459
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Charente Maritime (Poitou Charente)

    Informations professionnelles :
    Activité : Ingénieur développement logiciels
    Secteur : Industrie

    Informations forums :
    Inscription : septembre 2016
    Messages : 2 459
    Points : 4 200
    Points
    4 200
    Billets dans le blog
    1

    Par défaut

    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;'"
    Il dit non avec la tête
    mais il dit oui avec le coeur
    il dit oui à ce qu’il aime
    il dit non au professeur {Jacques PRÉVERT}

  8. #8
    Nouveau membre du Club Avatar de morobaboumar
    Inscrit en
    septembre 2009
    Messages
    114
    Détails du profil
    Informations forums :
    Inscription : septembre 2009
    Messages : 114
    Points : 39
    Points
    39

    Par défaut

    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.
    Le savoir est la lumière de l'esprit
    Le chemin de la réussite

    Qui cherche positivement trouve
    Tout ce qui brille n'est pas l'or ou diamant
    Mais l'or et le diamant se trouvent avec sagesse, intelligence et effort

  9. #9
    Expert confirmé
    Avatar de dysorthographie
    Homme Profil pro
    Ingénieur développement logiciels
    Inscrit en
    septembre 2016
    Messages
    2 459
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Charente Maritime (Poitou Charente)

    Informations professionnelles :
    Activité : Ingénieur développement logiciels
    Secteur : Industrie

    Informations forums :
    Inscription : septembre 2016
    Messages : 2 459
    Points : 4 200
    Points
    4 200
    Billets dans le blog
    1

    Par défaut

    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.
    Il dit non avec la tête
    mais il dit oui avec le coeur
    il dit oui à ce qu’il aime
    il dit non au professeur {Jacques PRÉVERT}

  10. #10
    Nouveau membre du Club Avatar de morobaboumar
    Inscrit en
    septembre 2009
    Messages
    114
    Détails du profil
    Informations forums :
    Inscription : septembre 2009
    Messages : 114
    Points : 39
    Points
    39

    Par défaut

    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 !
    Fichiers attachés Fichiers attachés
    Le savoir est la lumière de l'esprit
    Le chemin de la réussite

    Qui cherche positivement trouve
    Tout ce qui brille n'est pas l'or ou diamant
    Mais l'or et le diamant se trouvent avec sagesse, intelligence et effort

  11. #11
    Nouveau membre du Club Avatar de morobaboumar
    Inscrit en
    septembre 2009
    Messages
    114
    Détails du profil
    Informations forums :
    Inscription : septembre 2009
    Messages : 114
    Points : 39
    Points
    39

    Par défaut

    Citation Envoyé par dysorthographie Voir le message
    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
    Le savoir est la lumière de l'esprit
    Le chemin de la réussite

    Qui cherche positivement trouve
    Tout ce qui brille n'est pas l'or ou diamant
    Mais l'or et le diamant se trouvent avec sagesse, intelligence et effort

  12. #12
    Membre éprouvé
    Homme Profil pro
    retraité
    Inscrit en
    juin 2012
    Messages
    614
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : retraité
    Secteur : Associations - ONG

    Informations forums :
    Inscription : juin 2012
    Messages : 614
    Points : 987
    Points
    987

    Par défaut

    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.

  13. #13
    Nouveau membre du Club Avatar de morobaboumar
    Inscrit en
    septembre 2009
    Messages
    114
    Détails du profil
    Informations forums :
    Inscription : septembre 2009
    Messages : 114
    Points : 39
    Points
    39

    Par défaut Remerciement, demande de poursuite de la discussion

    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
    Le savoir est la lumière de l'esprit
    Le chemin de la réussite

    Qui cherche positivement trouve
    Tout ce qui brille n'est pas l'or ou diamant
    Mais l'or et le diamant se trouvent avec sagesse, intelligence et effort

  14. #14
    Nouveau membre du Club Avatar de morobaboumar
    Inscrit en
    septembre 2009
    Messages
    114
    Détails du profil
    Informations forums :
    Inscription : septembre 2009
    Messages : 114
    Points : 39
    Points
    39

    Par défaut Remerciement, demande de poursuite de la discussion

    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
    Fichiers attachés Fichiers attachés
    Le savoir est la lumière de l'esprit
    Le chemin de la réussite

    Qui cherche positivement trouve
    Tout ce qui brille n'est pas l'or ou diamant
    Mais l'or et le diamant se trouvent avec sagesse, intelligence et effort

  15. #15
    Membre éprouvé
    Homme Profil pro
    retraité
    Inscrit en
    juin 2012
    Messages
    614
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : retraité
    Secteur : Associations - ONG

    Informations forums :
    Inscription : juin 2012
    Messages : 614
    Points : 987
    Points
    987

    Par défaut

    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.
    Fichiers attachés Fichiers attachés

  16. #16
    Nouveau membre du Club Avatar de morobaboumar
    Inscrit en
    septembre 2009
    Messages
    114
    Détails du profil
    Informations forums :
    Inscription : septembre 2009
    Messages : 114
    Points : 39
    Points
    39

    Par défaut

    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
    Images attachées Images attachées  
    Le savoir est la lumière de l'esprit
    Le chemin de la réussite

    Qui cherche positivement trouve
    Tout ce qui brille n'est pas l'or ou diamant
    Mais l'or et le diamant se trouvent avec sagesse, intelligence et effort

  17. #17
    Membre éprouvé
    Homme Profil pro
    retraité
    Inscrit en
    juin 2012
    Messages
    614
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : retraité
    Secteur : Associations - ONG

    Informations forums :
    Inscription : juin 2012
    Messages : 614
    Points : 987
    Points
    987

    Par défaut

    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:
    Nom : ImportAr.jpg
Affichages : 60
Taille : 130,9 Ko
    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
    Nom : InfosNotesAr.jpg
Affichages : 67
Taille : 180,4 Ko
    Il ne semble pas y avoir de problème lié aux sens d'écriture.
    Cordialement.

  18. #18
    Nouveau membre du Club Avatar de morobaboumar
    Inscrit en
    septembre 2009
    Messages
    114
    Détails du profil
    Informations forums :
    Inscription : septembre 2009
    Messages : 114
    Points : 39
    Points
    39

    Par défaut

    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.
    Nom : NOTES DE COMPOSITIONS_Morobaboumar.jpg
Affichages : 57
Taille : 422,8 Ko
    Le savoir est la lumière de l'esprit
    Le chemin de la réussite

    Qui cherche positivement trouve
    Tout ce qui brille n'est pas l'or ou diamant
    Mais l'or et le diamant se trouvent avec sagesse, intelligence et effort

  19. #19
    Membre éprouvé
    Homme Profil pro
    retraité
    Inscrit en
    juin 2012
    Messages
    614
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : retraité
    Secteur : Associations - ONG

    Informations forums :
    Inscription : juin 2012
    Messages : 614
    Points : 987
    Points
    987

    Par défaut

    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.

  20. #20
    Nouveau membre du Club Avatar de morobaboumar
    Inscrit en
    septembre 2009
    Messages
    114
    Détails du profil
    Informations forums :
    Inscription : septembre 2009
    Messages : 114
    Points : 39
    Points
    39

    Par défaut

    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
    Fichiers attachés Fichiers attachés
    Le savoir est la lumière de l'esprit
    Le chemin de la réussite

    Qui cherche positivement trouve
    Tout ce qui brille n'est pas l'or ou diamant
    Mais l'or et le diamant se trouvent avec sagesse, intelligence et effort

+ Répondre à la discussion
Cette discussion est résolue.
Page 1 sur 2 12 DernièreDernière

Discussions similaires

  1. Demande correction du code
    Par ouiissemovic dans le forum PHP & MySQL
    Réponses: 3
    Dernier message: 14/04/2010, 18h18
  2. Correction du code
    Par punisher999 dans le forum Langage
    Réponses: 8
    Dernier message: 28/01/2007, 22h26
  3. code pour import d'une table d'un fichier HTM
    Par jeanluc065 dans le forum Access
    Réponses: 7
    Dernier message: 26/10/2006, 09h09

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo