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
| Sub Export()
'Ici l'importation se déclenche en cliquant sur le bouton "Commande1"
'mais on peut aussi mettre ce code à l'ouverture d'un formulaire
Dim oApp As Excel.Application
Dim oWkb As Excel.Workbook
Dim oWSht As Excel.Worksheet
Dim rs As Recordset
Dim ColNumDoc As Integer, ColTitreDoc As Integer, ColJalon As Integer, ColPilote As Integer, ColContributeur As Integer
Dim ColPrevision As Integer, ColReception As Integer, ColSoumission As Integer
'Définition des paramètres de la table et de l'onglet d'import
StrNomTable = "R_Export"
StrNomFeuille = "Import MSP"
StrNomFichier = "C:\Users\...nomfichier"
'''Définition des numéros de colonnes
ColNumDoc = 2
ColTitreDoc = 1
ColJalon = 3
ColPilote = 4
ColContributeur = 5
ColSoumission = 8
'Paramétrage des colonnes "Soumissions"
ColPrevision = 6
ColReception = 7
'Définition des applications excel et access
Set oApp = CreateObject("excel.application")
Set oWkb = oApp.Workbooks.Open(StrNomFichier) 'mettez ici le chemin vers votre fichier Excel
Set oWSht = oWkb.Worksheets(StrNomFeuille) 'mettez ici le nom de la feuille qui contient les données à importer
Set rs = CurrentDb.OpenRecordset("SELECT " & StrNomTable & ".* FROM " & StrNomTable & ";")
'première ligne ou commence l'import
i = 2
'pour éviter les messages lors de l'ajout des enregistrements
'DoCmd.SetWarnings False
'tant qu'on n'est pas arrivés à la ligne 600 du tableur
Do Until rs.EOF
'requète SQL (avec en paramètre la ligne i et le numéro de la colonne comme précisé au-dessus)
oWSht.Cells(i, ColNumDoc) = rs("NumDoc")
oWSht.Cells(i, ColTitreDoc) = rs("TitreDoc")
oWSht.Cells(i, ColJalon) = rs("Jalon")
oWSht.Cells(i, ColPilote) = rs("Pilote")
oWSht.Cells(i, ColContributeur) = rs("Contributeurs")
oWSht.Cells(i, ColSoumission) = rs("N°Soumission")
'Toutes les dates Soumissions
oWSht.Cells(i, ColPrevision) = rs("DatePrévisionnelle")
oWSht.Cells(i, ColReception) = rs("DateRéception")
rs.MoveNext
'on incrémente la variable i pour passer à la ligne suivante
i = i + 1
Loop
DoCmd.SetWarnings True 'on réactive les messages d'erreurs
rs.Close
'oWkb.Close
oApp.Save
oApp.Quit
Set rs = Nothing
Set oWSht = Nothing 'on vide les variables
Set oWbk = Nothing
Set oApp = Nothing
End Sub |
Partager