Sub Pu1rk_write () Dim myCn As New ADODB.Connection Dim myrs As New ADODB.Recordset Dim strcon As String 'ADO database connection string strcon = "PROVIDER = SQLOLEDB; SERVER = 172.16.2.2; UID = sa; PWD = tpcims; DATABASE = Movex12 "DL580" 'DL580-1 ON Error Goto error: mycn.connectionstring = strcon' Set timeout, indicating that the command will always wait until the command is executed, MYCN.COMMANDTIMEOUT = 0 mycn.open myrs.activeConnection = mycn 'opens the stored procedure , Parameter is I3 cell content mYStr = "execute pu1rk_zhangzs'" RANGE ("I6") "'"' mystr = "SELECT TOP 1 * from mittra" 'msgbox (mystr) myrs.open mystr' for Recordset assignment If there is no IF MYRS.EOF THEN MSGBOX "Quality Inspection Station has not yet judged / you have not yet launched!", Vbokonly, "Error" Range ("i6"). Value = "" EXIT SUB END IF ' Worksheet Lens Protection 'Worksheets ("Finishing Inventory") .unprotect Password: = "zhangzs"' Inserts the queryed data RANGE ("B6") = "库 别:" TRIM (MYRS! Library) RANGE "F6") = trim (MYRS! Material number) RANGE ("c17") = trim (Myrs! Trading Date) Range ("b9") = Trim (MYRS!) RANGE ("D9") = Trim (MyRS ! Steel) RANGE ("f9") = Trim (MYRS! Substream outer diameter) RANGE ("h9") = Trim (MYRS! Desert length) "M" if Trim (Trim (MYRS! Note)) = "," THEN RANGE ("B15") = "Remarks : "Else Range (" B15 ") =" Note: " Trim (Myrs! Remarks) end if n = 2 'initial variable M = 11 do while not myrs.eof cells (11, n) = trim (MyRs! Measure) Cells (M 1, N) = "Ross" Cells (M 1, N 1) = "Weight (T)" Cells (M 2, N) = TRIM (MYRS! Actual number) Cells (M 2, N 1) = Trim (myrs! Weight) Myrs.Movenext n = n
2 loop 'Worksheets ("Finishing Instrument") .protect Password: = "zhangzs", DrawingObjects: = true, contents: = true, Scenarios: = true' total weight, total number Range ("j9") = range ("B13") RANGE ("f13") RANGE ("H13) Range (" J13) Range ("L13) = Range (" C13 ") RANGE (" E13 ") RANGE (" G13 ") RANGE (" K13) Range ("M13") 'Close connection Myrs.close mycn.close exit sub' Error performing the following code error: msgBox err.description, Vbokonly, "Error Message" End subs pu1rk_cle () cancel worksheet protects Worksheets ("Finishing") .unprotect Password: = "zhangzs" 'Clear part of the cell Content Range ("B6") = "Lib] =" "Range (" B9 ") =" "Range (" D9 ") =" Range ("D9") = "" Range ("D9") = "" Range ("F9") = "" Range ("H9") = "" Range ("C16") = "" RANGE ("b11") = "" "RANGE (" D11) = "" RANGE ("F11") = "" "" H11 ") =" "RANGE (" J11 ") =" "RANGE (" L11 ") =" "Range (" b15 ") =" Remarks: "The total number of clearance, total weight Range ("J9") = "" Range ("L9") = "" for i = 2 to 13 for j = 12 to 13 cells (j, i) = "" Next J next i 'for worksheet plus "Worksheets ("Finishing Intention") .protect Password: = "zhangzs", DrawingObjects: = T Rue, Contents: = true, Scenarios: = TrueEnd Sub
Private subworksheet_change (Byval Target Asheng) if target.column = 9 and target.row = 6 TEN CALL PU1RK_CLEAR IF RANGE ("i6") <> "" THEN CALLEND SUB - Picture: