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

    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

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

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

    Informations forums :
    Inscription : juin 2012
    Messages : 544
    Points : 872
    Points
    872

    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
    Membre émérite Avatar de dysorthographie
    Homme Profil pro
    Ingénieur développement logiciels
    Inscrit en
    septembre 2016
    Messages
    1 687
    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 : 1 687
    Points : 2 868
    Points
    2 868

    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
    63
    Détails du profil
    Informations forums :
    Inscription : septembre 2009
    Messages : 63
    Points : 29
    Points
    29

    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

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

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

    Informations forums :
    Inscription : juin 2012
    Messages : 544
    Points : 872
    Points
    872

    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
    63
    Détails du profil
    Informations forums :
    Inscription : septembre 2009
    Messages : 63
    Points : 29
    Points
    29

    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.

  7. #7
    Membre émérite Avatar de dysorthographie
    Homme Profil pro
    Ingénieur développement logiciels
    Inscrit en
    septembre 2016
    Messages
    1 687
    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 : 1 687
    Points : 2 868
    Points
    2 868

    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
    63
    Détails du profil
    Informations forums :
    Inscription : septembre 2009
    Messages : 63
    Points : 29
    Points
    29

    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.

  9. #9
    Membre émérite Avatar de dysorthographie
    Homme Profil pro
    Ingénieur développement logiciels
    Inscrit en
    septembre 2016
    Messages
    1 687
    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 : 1 687
    Points : 2 868
    Points
    2 868

    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
    63
    Détails du profil
    Informations forums :
    Inscription : septembre 2009
    Messages : 63
    Points : 29
    Points
    29

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

Discussions similaires

  1. Demande correction du code
    Par ouiissemovic dans le forum PHP & MySQL
    Réponses: 3
    Dernier message: 14/04/2010, 17h18
  2. Correction du code
    Par punisher999 dans le forum Langage
    Réponses: 8
    Dernier message: 28/01/2007, 21h26
  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, 08h09

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