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
| Private Sub cmd_BA_KFE_Click()
Dim rst As DAO.Recordset
Dim xlapp As Excel.Application
Dim strg As String
Dim cpt As Integer
Dim i As Byte
'récupération des informations
strg = "select * from R_Bulletin_Analyse_kfe Where val(numero_lot)=" & Val(num_lot.Value) & ""
'ancien code qui fonctionnait avt exportation dans sql server
Set rst = CurrentDb.OpenRecordset(strg)
'nouveau code qui ne fonctionne tjrs pas après exportation dans sql server
Set rst = CurrentDb.OpenRecordset(strg, , dbSeeChanges)
If rst.RecordCount < 1 Then
MsgBox "aucun enregistrement trouvés"
Exit Sub
Else
'ouverture du fichier excel
If (xlapp Is Nothing) Then
Set xlapp = CreateObject("excel.application")
xlapp.Visible = True
xlapp.Workbooks.Open Application.CurrentProject.Path & "\rapport\kfe\bulletin_analyse_kfe.xlt", , yes
End If
rst.MoveFirst
Do Until rst.EOF
xlapp.Cells(1, 6) = rst("autorisation").Value & " " & rst("ref_demande_insp").Value
xlapp.Cells(5, 6) = rst("lib_produit").Value
xlapp.Cells(6, 6) = rst("marque_client").Value
xlapp.Cells(7, 6) = rst("numero_lot").Value
xlapp.Cells(8, 6) = rst("nb_sacs").Value
xlapp.Cells(9, 6) = rst("classification_iv").Value
xlapp.Cells(10, 6) = rst("entrepot").Value
xlapp.Cells(11, 6) = rst("date_bulletin_analyse").Value
xlapp.Cells(13, 6) = rst("humidite").Value & " " & "%"
xlapp.Cells(14, 6) = rst("mat_etrangere").Value & " " & "%"
xlapp.Cells(15, 6) = rst("poids_echantillon").Value & " " & "g"
xlapp.Cells(16, 6) = rst("nb_defauts").Value
xlapp.Cells(19, 6) = rst("avarie_seche").Value
xlapp.Cells(20, 6) = rst("cerise").Value
xlapp.Cells(21, 6) = rst("noire").Value
xlapp.Cells(22, 6) = rst("sure").Value
xlapp.Cells(23, 6) = rst("parche").Value
xlapp.Cells(24, 6) = rst("demi_noire").Value
xlapp.Cells(25, 6) = rst("spongieuse").Value
xlapp.Cells(26, 6) = rst("blanche").Value
xlapp.Cells(27, 6) = rst("ridee").Value
xlapp.Cells(28, 6) = rst("immature").Value
xlapp.Cells(29, 6) = rst("indesirable").Value
xlapp.Cells(30, 6) = rst("coquille").Value
xlapp.Cells(31, 6) = rst("brisure").Value
xlapp.Cells(32, 6) = rst("pique").Value
xlapp.Cells(33, 6) = rst("grosse_peau").Value
xlapp.Cells(34, 6) = rst("petite_peau").Value
xlapp.Cells(35, 6) = rst("gros_bois").Value
xlapp.Cells(36, 6) = rst("bois_moyen").Value
xlapp.Cells(37, 6) = rst("petit_bois").Value
xlapp.Cells(40, 5) = rst("tamis_18").Value
xlapp.Cells(41, 5) = rst("tamis_16").Value
xlapp.Cells(42, 5) = rst("tamis_14").Value
xlapp.Cells(43, 5) = rst("tamis_12").Value
xlapp.Cells(44, 5) = rst("tamis_10").Value
xlapp.Cells(45, 5) = rst("tamis_bas").Value
xlapp.Cells(48, 5) = rst("scelle_1").Value
xlapp.Cells(49, 5) = rst("scelle_2").Value
rst.MoveNext
cpt = cpt + 1
Loop
End If
'impression du rapport
'xlapp.ActiveWorkbook.PrintOut
'fermeture d'excel
'xlapp.ActiveWorkbook.Close savechanges:=False
'xlapp.Quit
'Set xlapp = Nothing
End Sub |
Partager