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
| Private Sub Commande3_Click()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim xlApp As Excel.Application
Dim xlSheet As Excel.Worksheet
Dim FichierExcel As Excel.Workbook
Set db = CurrentDb
Set rst = db.OpenRecordset("Excel", dbOpenSnapshot)
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets.Add
xlSheet.Name = ("Serie")
col = 1
While Not rst.EOF
Row = 1
col = col + 1
xlSheet.Range(xlSheet.Cells(2, 1), xlSheet.Cells(2, 25)).EntireColumn.AutoFit
xlSheet.Cells(2, 2) = Date
xlSheet.Cells(2, 1) = "Date:"
xlSheet.Cells(2, 5) = "Serie:"
xlSheet.Range(xlSheet.Cells(2, 2), xlSheet.Cells(2, 4)).MergeCells = True
xlSheet.Range(xlSheet.Cells(2, 6), xlSheet.Cells(2, 9)).MergeCells = True
xlSheet.Cells(Row, col).EntireColumn.AutoFit
xlSheet.Cells(5, col).Borders(xlEdgeBottom).LineStyle = xlContinuous
xlSheet.Cells(5, col).Borders(xlEdgeRight).LineStyle = xlContinuous
xlSheet.Cells(5, col).Borders(xlEdgeTop).LineStyle = xlContinuous
xlSheet.Cells(6, col).Borders(xlEdgeBottom).LineStyle = xlContinuous
xlSheet.Cells(6, col).Borders(xlEdgeRight).LineStyle = xlContinuous
xlSheet.Cells(6, col).Borders(xlEdgeTop).LineStyle = xlContinuous
xlSheet.Cells(7, col).Borders(xlEdgeBottom).LineStyle = xlContinuous
xlSheet.Cells(7, col).Borders(xlEdgeRight).LineStyle = xlContinuous
xlSheet.Cells(7, col).Borders(xlEdgeTop).LineStyle = xlContinuous
xlSheet.Cells(8, col).Borders(xlEdgeBottom).LineStyle = xlContinuous
xlSheet.Cells(8, col).Borders(xlEdgeRight).LineStyle = xlContinuous
xlSheet.Cells(8, col).Borders(xlEdgeTop).LineStyle = xlContinuous
xlSheet.Cells(9, col).Borders(xlEdgeBottom).LineStyle = xlContinuous
xlSheet.Cells(9, col).Borders(xlEdgeRight).LineStyle = xlContinuous
xlSheet.Cells(9, col).Borders(xlEdgeTop).LineStyle = xlContinuous
xlSheet.Cells(5, col) = Format(Now, "h:mm")
xlSheet.Cells(2, 6) = rst.Fields("Serial")
xlSheet.Cells(5, 1) = "H"
xlSheet.Cells(5, 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
xlSheet.Cells(5, 1).Borders(xlEdgeTop).LineStyle = xlContinuous
xlSheet.Cells(5, 1).Borders(xlEdgeLeft).LineStyle = xlContinuous
xlSheet.Cells(5, 1).Borders(xlEdgeRight).LineStyle = xlContinuous
xlSheet.Cells(6, 1) = rst.Fields("Choix.Choix1")
xlSheet.Cells(6, 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
xlSheet.Cells(6, 1).Borders(xlEdgeLeft).LineStyle = xlContinuous
xlSheet.Cells(6, 1).Borders(xlEdgeRight).LineStyle = xlContinuous
xlSheet.Cells(7, 1) = rst.Fields("Choix.Choix2")
xlSheet.Cells(7, 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
xlSheet.Cells(7, 1).Borders(xlEdgeRight).LineStyle = xlContinuous
xlSheet.Cells(7, 1).Borders(xlEdgeLeft).LineStyle = xlContinuous
xlSheet.Cells(8, 1) = rst.Fields("Choix.Choix3")
xlSheet.Cells(8, 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
xlSheet.Cells(8, 1).Borders(xlEdgeRight).LineStyle = xlContinuous
xlSheet.Cells(8, 1).Borders(xlEdgeLeft).LineStyle = xlContinuous
xlSheet.Cells(9, 1) = rst.Fields("Choix.Choix4")
xlSheet.Cells(9, 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
xlSheet.Cells(9, 1).Borders(xlEdgeRight).LineStyle = xlContinuous
xlSheet.Cells(9, 1).Borders(xlEdgeLeft).LineStyle = xlContinuous
Row = Row + 1
xlSheet.Cells(5, col) = rst.Fields(1)
Row = Row + 1
xlSheet.Cells(6, col) = rst.Fields(2)
Row = Row + 1
xlSheet.Cells(7, col) = rst.Fields(3)
Row = Row + 1
xlSheet.Cells(8, col) = rst.Fields(4)
Row = Row + 1
xlSheet.Cells(9, col) = rst.Fields(5)
Row = Row + 1
rst.MoveNext
Wend
' code de fermeture et libération des objets
xlBook.SaveAs "c:\Sauvegarde\control1.xls"
xlApp.Quit
Set rec = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End Sub |
Partager