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
| Sub tridesresultats()
Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object
Dim matactive As String
Dim resultat As String
Dim unite As String
Dim dat As String
Dim numbon As String
Dim essai As Worksheet
Dim essai2 As Worksheet
'code qui crée un nouveau classeur et des nouvelles feuilles dedans
Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Add
oBook.Worksheets.Add
oBook.Worksheets.Add
oBook.Worksheets.Add
oBook.Worksheets.Add
'code pour la première feuille du classeur final
ActiveWorkbook.Sheets("Artichaut").Select
compteur = 0
Set oSheet = oBook.Worksheets(1)
oSheet.Name = "Artic"
oSheet.Range("A1").Value = "Matière active"
oSheet.Range("B1").Value = "Résultat"
oSheet.Range("A1:F1").Font.Bold = True
oSheet.Range("C1").Value = "Unité"
oSheet.Range("D1").Value = "Date"
oSheet.Range("E1").Value = "N° de bon"
For i = 2 To 10000
Cells(i, 6).Select
If ActiveCell.Value = "< LQ" Then
ElseIf ActiveCell.Value = "" Then
ElseIf ActiveCell.Value = "0" Then
MsgBox ("résultat nul")
Else: compteur = compteur + 1
resultat = ActiveCell.Value
unite = ActiveCell.Offset(0, 1).Value
matactive = ActiveCell.Offset(0, -2).Value
dat = ActiveCell.Offset(0, -1).Value
numbon = ActiveCell.Offset(0, -4).Value
Activebook = book516
If ActiveSheet.[A2] = "" Then
ActiveSheet.[A2].Select
Else
ActiveSheet.Range("A1").End(xlDown).Offset(1, 0).Select
End If
With ActiveCell
.Value = matactive
.Offset(0, 1).Value = resultat
.Offset(0, 2).Value = unite
End With
End If
Next i
MsgBox ("Le nombre total de détections sur ce produit est de " & compteur)
Set oSheet = oBook.Worksheets(2)
oSheet.Range("A1").Value = "Matière active"
oSheet.Range("B1").Value = "Résultat"
oSheet.Range("A1:F1").Font.Bold = True
oSheet.Range("C1").Value = "Unité"
oSheet.Range("D1").Value = "Date"
oSheet.Range("E1").Value = "N° de bon"
oSheet.Name = "Chou-Fleur"
Set oSheet = oBook.Worksheets(3)
oSheet.Range("A1").Value = "Matière active"
oSheet.Range("B1").Value = "Résultat"
oSheet.Range("A1:F1").Font.Bold = True
oSheet.Range("C1").Value = "Unité"
oSheet.Range("D1").Value = "Date"
oSheet.Range("E1").Value = "N° de bon"
oSheet.Name = "Brocoli"
Set oSheet = oBook.Worksheets(4)
oSheet.Range("A1").Value = "Matière active"
oSheet.Range("B1").Value = "Résultat"
oSheet.Range("A1:F1").Font.Bold = True
oSheet.Range("C1").Value = "Unité"
oSheet.Range("D1").Value = "Date"
oSheet.Range("E1").Value = "N° de bon"
oSheet.Name = "Carotte"
Set oSheet = oBook.Worksheets(5)
oSheet.Range("A1").Value = "Matière active"
oSheet.Range("B1").Value = "Résultat"
oSheet.Range("A1:F1").Font.Bold = True
oSheet.Range("C1").Value = "Unité"
oSheet.Range("D1").Value = "Date"
oSheet.Range("E1").Value = "N° de bon"
oSheet.Name = "Tomate"
Set oSheet = oBook.Worksheets(6)
oSheet.Range("A1").Value = "Matière active"
oSheet.Range("B1").Value = "Résultat"
oSheet.Range("A1:F1").Font.Bold = True
oSheet.Range("C1").Value = "Unité"
oSheet.Range("D1").Value = "Date"
oSheet.Range("E1").Value = "N° de bon"
oSheet.Name = "Haricot"
'Save the Workbook and Quit Excel
oBook.SaveAs "C:\Book516.xls "
oExcel.Quit
End Sub |
Partager