Sub Pu1rk_write() ? Dim myCn As New ADODB.Connection ? Dim myrs As New ADODB.Recordset ? Dim strcon As String ? ? 'ADO数据库连接串 ? strcon = "PROVIDER=SQLOLEDB;SERVER=172.16.2.2;UID=sa;PWD=tpcims;DATABASE=Movex12" 'DL580-1 ? On Error GoTo Error: ? myCn.ConnectionString = strcon ? ? '设置超时时间,为0时表示,将一直等待到命令执行完毕 ? myCn.CommandTimeout = 0 ? ? myCn.Open ? myrs.ActiveConnection = myCn ? ? '打开存储过程,参数为I3单元格内容 ? mystr = "execute? pu1rk_zhangzs? '" + Range("I6") + "'" ?' mystr = "select top 1 * from mittra? " ?' MsgBox (mystr) ? myrs.Open mystr '为 Recordset 赋值 ? ? '如果没有查出记录 ? If myrs.EOF Then ?? MsgBox "质检站还没判定/您还没有入库操作!", vbOKOnly, "错误" ?? Range("I6").Value = "" ?? Exit Sub ? End If ? ?'为工作表解除保护 ?'Worksheets("精整入库").Unprotect Password:="zhangzs" ? ?'插入所查询的数据 ?Range("B6") = "库别:" + Trim(myrs!库位) ?Range("F6") = Trim(myrs!物料号) ?Range("C17") = Trim(myrs!交易日期) ?Range("B9") = Trim(myrs!炉号) ?Range("D9") = Trim(myrs!钢种) ?Range("F9") = Trim(myrs!铸坯外径) ?Range("H9") = Trim(myrs!定尺长度) + "m" ? ?If Trim(Trim(myrs!备注)) = "," Then ?? Range("B15") = "备注: " ?Else ?? Range("B15") = "备注: " + Trim(myrs!备注) ?End If ? ?n = 2 '初始变量 ?m = 11 ?Do While Not myrs.EOF ?Cells(11, n) = Trim(myrs!倍尺数) ?Cells(m + 1, n) = "支数" ?Cells(m + 1, n + 1) = "重量(t)" ?Cells(m + 2, n) = Trim(myrs!实际支数) ?Cells(m + 2, n + 1) = Trim(myrs!重量) ?myrs.MoveNext ?n = n + 2 ?Loop ?'Worksheets("精整入库").Protect Password:="zhangzs", DrawingObjects:=True, contents:=True, Scenarios:=True ? ? '总重量,总支数 ? Range("J9") = Range("B13") + Range("D13") + Range("F13") + Range("H13") + Range("J13") + Range("L13") ? Range("L9") = Range("C13") + Range("E13") + Range("G13") + Range("I13") + Range("K13") + Range("M13") ? '关闭连接 ? myrs.Close ? myCn.Close ? Exit Sub ? ?'出现错误执行以下代码 Error: ? MsgBox Err.Description, vbOKOnly, "Error Message" End Sub Sub pu1rk_clear() ?'取消工作表保护 ?Worksheets("精整入库").Unprotect Password:="zhangzs" ?'清除部分单元格内容 ?Range("B6") = "库别:" ?Range("F6") = "" ?Range("C17") = "" ?Range("B9") = "" ?Range("D9") = "" ?Range("F9") = "" ?Range("H9") = "" ?Range("C16") = "" ?Range("B11") = "" ?Range("D11") = "" ?Range("F11") = "" ?Range("H11") = "" ?Range("J11") = "" ?Range("L11") = "" ?Range("B15") = "备注:" ? ?'清空总支数,总重量 ? Range("J9") = "" ? Range("L9") = "" ?For i = 2 To 13 ??? For j = 12 To 13 ???? Cells(j, i) = "" ??? Next j ?Next i ?'为工作表加保护 ?'Worksheets("精整入库").Protect Password:="zhangzs", DrawingObjects:=True, contents:=True, Scenarios:=True End Sub
Private Sub Worksheet_Change(ByVal Target As Range) ?If Target.Column = 9 And Target.Row = 6 Then ?? Call pu1rk_clear ?? If Range("I6") <> "" Then ???? Call Pu1rk_write ?? End If ?End If End Sub
? 
|