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 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142
| Sub ExportVendor()
'
' ExportVendor Macro
' Macro enregistrée le 17/10/2003 par William Osteux
'
Dim strVendor As String
Dim i, k As Integer
Dim adoConn As New ADODB.Connection
'adoConn.Provider = "Microsoft.Jet.Oledb.4.0"
'adoConn.ConnectionString = "N:\scorecard\scorecards.mdb"
adoConn.Open "Provider=SQLOLEDB;Data Source=172.31.112.44;Initial Catalog=Scorecards;Trusted_Connection=no;User ID=usr_write;Password=write;Network=dbmssocn"
periode = InputBox("Mois (de la forme AAAAMM):")
'---------------Travail sur l'onglet Total
Worksheets("Total").Select
NbrJoursEcoules = Range("A2").Value
Range("A6").Select
i = 1
Do Until ActiveCell = ""
i = i + 1
strVendor = ActiveCell.Value
Sql = "SELECT idVendor FROM Vendors WHERE codeVendor LIKE '" & strVendor & "'"
MTD_AGM = ActiveCell.Offset(0, 6)
MTD_Sales = ActiveCell.Offset(0, 4)
Stock = ActiveCell.Offset(0, 8)
MTD_COGS = ActiveCell.Offset(0, 5)
Total_QTYAVAIL = ActiveCell.Offset(0, 31)
Total_QTYORDER = ActiveCell.Offset(0, 30)
A_QTYAVAIL = ActiveCell.Offset(0, 19)
A_QTYORDER = ActiveCell.Offset(0, 18)
B_QTYAVAIL = ActiveCell.Offset(0, 21)
B_QTYORDER = ActiveCell.Offset(0, 20)
C_QTYAVAIL = ActiveCell.Offset(0, 23)
C_QTYORDER = ActiveCell.Offset(0, 22)
If Total_QTYORDER <> 0 Then
numFillRateTotal = CLng(Total_QTYAVAIL / Total_QTYORDER * 100)
Else
numFillRateTotal = 0
End If
If A_QTYORDER <> 0 Then
numFillRateA = CLng(A_QTYAVAIL / A_QTYORDER * 100)
Else
numFillRateA = 0
End If
If B_QTYORDER <> 0 Then
numFillRateB = CLng(B_QTYAVAIL / B_QTYORDER * 100)
Else
numFillRateB = 0
End If
If C_QTYORDER <> 0 Then
numFillRateC = CLng(C_QTYAVAIL / C_QTYORDER * 100)
Else
numFillRateC = 0
End If
Set RS = adoConn.Execute(Sql)
If RS.EOF Then
strResult = strResult & ", " & strVendor
SQLInsert = "INSERT INTO Vendors (codeVendor, nom, buyer, pm) VALUES ('" & ActiveCell.Value & "','" & ActiveCell.Offset(0, 1) & "',57,59)"
adoConn.Execute (SQLInsert)
strsql = "INSERT INTO VendorsResults (periode,codeVendor,ca,sagm,turn,stock6090,stock90180,stock180,stockBr91,fillRateTotal,fillRateA,fillRateB,fillRateC,dn90,clientsActifs,MTD_AGM,MTD_Sales,Stock,MTD_COGS,Total_QTYAVAIL,Total_QTYORDER,A_QTYAVAIL,A_QTYORDER,B_QTYAVAIL,B_QTYORDER,C_QTYAVAIL,C_QTYORDER,NbrJoursEcoules,stockBr91_RV)VALUES "
strsql = strsql & "(" & periode & ",'" & strVendor & "','" & Replace(CLng(ActiveCell.Offset(0, 4)), ",", ".")
strsql = strsql & "','" & Replace(CLng(ActiveCell.Offset(0, 7)) * 100, ",", ".") & "','" & Replace(CLng(ActiveCell.Offset(0, 9)), ",", ".")
strsql = strsql & "','" & Replace(CLng(ActiveCell.Offset(0, 15)), ",", ".") & "','" & Replace(CLng(ActiveCell.Offset(0, 16)), ",", ".")
strsql = strsql & "','" & Replace(CLng(ActiveCell.Offset(0, 17)), ",", ".") & "','" & Replace(CLng(ActiveCell.Offset(0, 13)), ",", ".")
strsql = strsql & "','" & Replace(numFillRateTotal, ",", ".") & "','" & Replace(numFillRateA, ",", ".")
strsql = strsql & "','" & Replace(numFillRateB, ",", ".") & "','" & Replace(numFillRateC, ",", ".")
strsql = strsql & "','" & Replace(CLng(ActiveCell.Offset(0, 33)), ",", ".") & "','" & Replace(CLng(ActiveCell.Offset(0, 35)), ",", ".")
strsql = strsql & "','" & Replace(CLng(MTD_AGM), ",", ".") & "','" & Replace(CLng(MTD_Sales), ",", ".")
strsql = strsql & "','" & Replace(Stock, ",", ".") & "','" & Replace(MTD_COGS, ",", ".")
strsql = strsql & "','" & Replace(Total_QTYAVAIL, ",", ".") & "','" & Replace(Total_QTYORDER, ",", ".")
strsql = strsql & "','" & Replace(A_QTYAVAIL, ",", ".") & "','" & Replace(A_QTYORDER, ",", ".")
strsql = strsql & "','" & Replace(B_QTYAVAIL, ",", ".") & "','" & Replace(B_QTYORDER, ",", ".")
strsql = strsql & "','" & Replace(C_QTYAVAIL, ",", ".") & "','" & Replace(C_QTYORDER, ",", ".") & "','" & NbrJoursEcoules & "','" & Replace(CLng(ActiveCell.Offset(0, 37)), ",", ".") & "')"
adoConn.Execute (strsql)
Else
sql2 = "SELECT idResult FROM VendorsResults WHERE ((codeVendor LIKE '" & strVendor & "') AND (periode=" & periode & "))"
Set RS2 = adoConn.Execute(sql2)
If RS2.EOF Then
strsql = "INSERT INTO VendorsResults (periode,codeVendor,ca,sagm,turn,stock6090,stock90180,stock180,stockBr91,fillRateTotal,fillRateA,fillRateB,fillRateC,dn90,clientsActifs,MTD_AGM,MTD_Sales,Stock,MTD_COGS,Total_QTYAVAIL,Total_QTYORDER,A_QTYAVAIL,A_QTYORDER,B_QTYAVAIL,B_QTYORDER,C_QTYAVAIL,C_QTYORDER,NbrJoursEcoules,stockBr91_RV)VALUES "
strsql = strsql & "(" & periode & ",'" & strVendor & "','" & Replace(CLng(ActiveCell.Offset(0, 4)), ",", ".")
strsql = strsql & "','" & Replace(CLng(ActiveCell.Offset(0, 7)) * 100, ",", ".") & "','" & Replace(CLng(ActiveCell.Offset(0, 9)), ",", ".")
strsql = strsql & "','" & Replace(CLng(ActiveCell.Offset(0, 15)), ",", ".") & "','" & Replace(CLng(ActiveCell.Offset(0, 16)), ",", ".")
strsql = strsql & "','" & Replace(CLng(ActiveCell.Offset(0, 17)), ",", ".") & "','" & Replace(CLng(ActiveCell.Offset(0, 13)), ",", ".")
strsql = strsql & "','" & Replace(numFillRateTotal, ",", ".") & "','" & Replace(numFillRateA, ",", ".")
strsql = strsql & "','" & Replace(numFillRateB, ",", ".") & "','" & Replace(numFillRateC, ",", ".")
strsql = strsql & "','" & Replace(CLng(ActiveCell.Offset(0, 33)), ",", ".") & "','" & Replace(CLng(ActiveCell.Offset(0, 35)), ",", ".")
strsql = strsql & "','" & Replace(CLng(MTD_AGM), ",", ".") & "','" & Replace(CLng(MTD_Sales), ",", ".")
strsql = strsql & "','" & Replace(Stock, ",", ".") & "','" & Replace(MTD_COGS, ",", ".")
strsql = strsql & "','" & Replace(Total_QTYAVAIL, ",", ".") & "','" & Replace(Total_QTYORDER, ",", ".")
strsql = strsql & "','" & Replace(A_QTYAVAIL, ",", ".") & "','" & Replace(A_QTYORDER, ",", ".")
strsql = strsql & "','" & Replace(B_QTYAVAIL, ",", ".") & "','" & Replace(B_QTYORDER, ",", ".")
strsql = strsql & "','" & Replace(C_QTYAVAIL, ",", ".") & "','" & Replace(C_QTYORDER, ",", ".") & "','" & NbrJoursEcoules & "','" & Replace(CLng(ActiveCell.Offset(0, 37)), ",", ".") & "')"
Else
strsql = "update VendorsResults set "
strsql = strsql & "ca='" & Replace(CLng(ActiveCell.Offset(0, 4)), ",", ".") & "',sagm='" & Replace(CLng(ActiveCell.Offset(0, 7)) * 100, ",", ".") & "',turn='" & Replace(CLng(ActiveCell.Offset(0, 9)), ",", ".")
strsql = strsql & "',stock6090='" & Replace(CLng(ActiveCell.Offset(0, 15)), ",", ".") & "',stock90180='" & Replace(CLng(ActiveCell.Offset(0, 16)), ",", ".")
strsql = strsql & "',stock180='" & Replace(CLng(ActiveCell.Offset(0, 17)), ",", ".") & "',stockBr91='" & Replace(CLng(ActiveCell.Offset(0, 13)), ",", ".") & "',stockBr91_RV='" & Replace(CLng(ActiveCell.Offset(0, 37)), ",", ".")
strsql = strsql & "',dn90='" & Replace(CLng(ActiveCell.Offset(0, 33)), ",", ".") & "',clientsActifs='" & Replace(CLng(ActiveCell.Offset(0, 35)), ",", ".")
strsql = strsql & "',fillRateTotal='" & Replace(numFillRateTotal, ",", ".") & "',fillRateA='" & Replace(numFillRateA, ",", ".")
strsql = strsql & "',fillRateB='" & Replace(numFillRateB, ",", ".") & "',fillRateC='" & Replace(numFillRateC, ",", ".")
strsql = strsql & "',MTD_AGM='" & Replace(CLng(MTD_AGM), ",", ".") & "',MTD_Sales='" & Replace(CLng(MTD_Sales), ",", ".")
strsql = strsql & "',Stock='" & Replace(Stock, ",", ".") & "',MTD_COGS='" & Replace(MTD_COGS, ",", ".")
strsql = strsql & "',Total_QTYAVAIL='" & Replace(Total_QTYAVAIL, ",", ".") & "',Total_QTYORDER='" & Replace(Total_QTYORDER, ",", ".")
strsql = strsql & "',A_QTYAVAIL='" & Replace(A_QTYAVAIL, ",", ".") & "',A_QTYORDER='" & Replace(A_QTYORDER, ",", ".")
strsql = strsql & "',B_QTYAVAIL='" & Replace(B_QTYAVAIL, ",", ".") & "',B_QTYORDER='" & Replace(B_QTYORDER, ",", ".")
strsql = strsql & "',C_QTYAVAIL='" & Replace(C_QTYAVAIL, ",", ".") & "',C_QTYORDER='" & Replace(C_QTYORDER, ",", ".") & "',NbrJoursEcoules='" & NbrJoursEcoules
strsql = strsql & "' WHERE codeVendor='" & strVendor & "' AND periode=" & periode
End If
'MsgBox (strSQL)
'Range("C1").Value = strSQL
Debug.Print strsql
adoConn.Execute (strsql) '<<<< c'est là que ça plante...
End If
ActiveCell.Offset(1, 0).Select
Loop
'----Fin de travail sur l'onglet Total
adoConn.Close
Set adoConn = Nothing
'MsgBox ("Résultats" & strResult & "n'existe(nt) pas")
'
End Sub |
Partager