Discussion :

[morobaboumar]

Bonsoir membres du forum,
Comment pourrait on transférer les donner d'Excel dans une table Access 2013 par codes VBA ?
En faisant correspondre chaque colonne Excel par rapport à un champ précis d'une Table Access ?
Cordialement.

[hyperion13]

Salut
Le plus simple serait d'importer votre feuille de calculs avec liaison ou non dans une tbl de votre bdd. De créer ensuite un req pour ordonner vos champs

[morobaboumar]

Le plus simple serait d'importer votre feuille de calculs avec liaison ou non dans une tbl de votre bdd. De créer ensuite un req pour ordonner vos champs

Bonjour hyperion13,
Message compris.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
'Exemple de Code de Transfert de Données depuis Excel vers Access.
'Alors test ça dans Excel (export d'un nom & d'un prénom contenu dans les cellules A1 & A2 'vers la base d:\test.mdb dans la table1 contenant les champs Nom et Prénom):
Dim Access As Object
Dim Sql As String
Set Access = GetObject("d:\test.mdb")
Access.Visible = True
With Sheets(1)
    Sql = "insert into table1 ( Nom, prénom ) select """ & .Cells(1, 1) & """ , """ & .Cells(1, 2) & """;"
End With
Access.Application.docmd.runsql Sql
Set Access = Nothing

Cordialement.

[morobaboumar]

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
 
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 & "-FRANCAIS"
 
        '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)
            DoEvents
            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
36
 
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
 
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_FR WHERE annee_scol='" & Me.txtANNEE & "' AND classe_francais ='" & Me.txtCLASSE & "';"
    '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 & "] (anscol CHAR, NatureCompoAr CHAR, ClasseFr CHAR, mle_Eleve INTEGER, NomEleve CHAR);"
 
    DoCmd.SetWarnings False
 
    dbs.Execute strSQL
        If Not rst.EOF Then
            Do While Not rst.EOF
                strChamp = fNOM_parID_Matiere_FR(rst.Fields("matiere_francais"))
 
                strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN [" & strChamp & "] REAL;"
                DoEvents
                dbs.Execute strSQL
 
                rst.MoveNext
            Loop
        End If
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN TOTAL REAL;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN MOYENNE REAL;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN Classement CHAR;"
        DoEvents
        dbs.Execute strSQL
 
        strSQL = "ALTER TABLE  " & strNomTable & "  ADD COLUMN Appreciation CHAR;"
        DoEvents
        dbs.Execute strSQL
 
 Fichier = Me.sCheminFichier
 Feuille = Me.ListeClasseurs & "!"
 
    'Vide la Table Temporaire des KYC
    DoCmd.RunSQL "DELETE * FROM   " & strNomTable & ";"
 
    'Importe les données du classeur vers la table temporaire
    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
126
127
128
129
130
 
Sub InserrerNotes(vAnScol As String, vClas As String, vCompo As String)
    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 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 REQUETECLASSEFRANCAIS WHERE ANNEE_SCOL='" & vAnScol & "' AND ClasseFrancais ='" & 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("nom") & " " & rstEleve.Fields("prenom")
        Me.lblMessage.Visible = True
 
        strSQL = "SELECT * FROM " & strNomTable & " WHERE mle_Eleve =" & rstEleve.Fields("Mleeleve") & " AND anscol='" & vAnScol & "' AND NatureCompoAr ='" & vCompo & "';"
        Set rst = dbs.OpenRecordset(strSQL)
        If Not rst.EOF Then
            N = 4
            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é"
                'Mettre le controle d'existence ici
 
                If CompoDejaImportée_Fr(Me.txtANNEE, rstEleve("Mleeleve"), Me.txtCLASSE, Me.txtCOMPO) = False Then
 
                    strSQL = "INSERT INTO INFOS_COMPOSITION_FRANCAIS (idCompoF, anscol, mle_Eleve, ClasseFr, NatureCompoAr, Statut) VALUES (" & idComp & ", '" & stAnnee & "', " & vMle_El & ", '" & vClasse & "', '" & vNatCompo & "', '" & vStatut & "' );"
 
                    DoCmd.SetWarnings False
                    DoCmd.RunSQL strSQL
 
                        idAuto = NumeroAutoNotesFrancais()
 
                        DoEvents
 
                        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))
 
                            strSQL = "INSERT INTO NOTES_CLASSES_FRANCAIS (idNotesFrancais, idCF, matiereFr, coef) VALUES (" & idAuto & ", " & idComp & ", " & NumMat & ", " & sCoef & " );"
                            DoCmd.SetWarnings False
                            DoCmd.RunSQL strSQL
 
                            strSQL = "update NOTES_CLASSES_FRANCAIS set NOTES_CLASSES_FRANCAIS.Note =" & Replace(LaNote, ",", ".") & _
                            " where NOTES_CLASSES_FRANCAIS.idNotesFrancais =" & idAuto & ";"
                            DoCmd.SetWarnings False
                            DoCmd.RunSQL strSQL
                            strSQL = ""
 
 
                            'AfficherNotesEleve = AfficherNotesEleve & vbCrLf & rst.Fields(n + i).Name & "=" & rst.Fields(n + i).Value
                            'Debug.Print AfficherNotesEleve
                        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 "CLASSEFRANCAIS", , , "[ClasseFrancais]='" & 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_Fr"
            rst.Close
            rstEleve.Close
 
            Set rst = Nothing
            Set rstEleve = Nothing
 
             ' Delete the Employees table.
 
            dbs.Execute "DROP TABLE " & strNomTable & ";"
    End If
DoCmd.SetWarnings True
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.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
10
 
Private Sub Form_Load()
DoCmd.MoveSize 1000, 1000, 14500, 7000
'Me.NumCol = 3
'Me.NumColDepart = 6
If Not IsNull(Me.sCheminFichier) Then
    DoEvents
    RemplirListeClasseurs
End If
End Sub

Cordialement.