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
?
本文地址：http://com.8s8s.com/it/it27315.htm