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
| Function TransfertExcelAutomation1()
Dim xlApp As Excel.Application
Dim xlSheet As Excel.Worksheet
Dim xlBook As Excel.Workbook
Dim t0 As Single
Dim rec As DAO.Recordset
t0 = Timer
'Initialisations
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
'Ajouter une feuille de calcul
Set xlSheet = xlBook.Worksheets.Add
xlSheet.Name = "Tutor1"
Set rec = CurrentDb.OpenRecordset("Reqeaug", dbOpenSnapshot)
' le titre1
' écriture dans la cellule de ligne 1 et de colonne 1
xlSheet.Cells(1, 1) = "Première Structure des donées"
ExportFeuille xlSheet, rec
'''''''''''''''''
'''''''''''''''''
Set xlSheet = xlBook.Worksheets.Add
xlSheet.Name = "Tutor2"
Set rec = CurrentDb.OpenRecordset("Vapeureau", dbOpenSnapshot)
' le titre2
' écriture dans la cellule de ligne 1 et de colonne 1
xlSheet.Cells(1, 1) = "Deuxième Structure des donées"
ExportFeuille xlSheet, rec
rec.Close
'''''''''''''''''
Set xlSheet = xlBook.Worksheets.Add
xlSheet.Name = "Tutor3"
Set rec = CurrentDb.OpenRecordset("pptesCO2", dbOpenSnapshot)
' le titre3
' écriture dans la cellule de ligne 1 et de colonne 1
xlSheet.Cells(1, 1) = " Troisième Structure des donées"
ExportFeuille xlSheet, rec
'''''''''''''''''
Set xlSheet = xlBook.Worksheets.Add
xlSheet.Name = "Tutor4"
Set rec = CurrentDb.OpenRecordset("pptésair", dbOpenSnapshot)
' le titre4
' écriture dans la cellule de ligne 1 et de colonne 1
xlSheet.Cells(1, 1) = "Quatrième Structure des donées"
ExportFeuille xlSheet, rec
'''''''''''''''''
Set xlSheet = xlBook.Worksheets.Add
xlSheet.Name = "Tutor4"
Set rec = CurrentDb.OpenRecordset("pptéseau", dbOpenSnapshot)
' le titre4
' écriture dans la cellule de ligne 1 et de colonne 1
xlSheet.Cells(1, 1) = "Cinquième Structure des donées"
ExportFeuille xlSheet, rec
'''''''''''''''''
''''''''''''''''''
' code de fermeture et libération des objets
xlBook.SaveAs "C:\Users\utilisateur\Desktop\documents du stage\Monformulaire.xlsx"
xlBook.Close False
rec.Close
Set rec = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing
Debug.Print "Export complet en ", Format(Timer - t0, "0") & " secondes"
End Function |
Partager