PU1入库情况检查

'写 判定部分数据

Sub Pu1zj_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.9;UID=sa;PWD=tpcims;DATABASE=JTQfmis_data" 'DL580-1

On Error GoTo Error:

myCn.ConnectionString = strcon

'设置超时时间，为0时表示，将一直等待到命令执行完毕

myCn.CommandTimeout = 0

myCn.Open

myrs.ActiveConnection = myCn

mystr_zj = "select * from 铸坯判定书_1 where 炉号= '" + CStr(Range("B3")) + "'"

myrs.Open mystr_zj

If myrs.EOF Then

MsgBox "质检站还没有判定!", vbOKOnly, "错误"

Exit Sub

End If

Range("E3") = Trim(myrs!订单)

Range("H3") = Trim(myrs!钢种)

Range("L3") = Trim(myrs!规格) + "mm"

Range("O3") = Trim(myrs!合同号)

Range("T5") = Trim(myrs!支数)

Range("T6") = Trim(myrs!重量)

Range("C2") = Trim(myrs!生产日期)

Range("R2") = Trim(myrs!判定日期)

'关闭连接

myrs.Close

myCn.Close

Exit Sub

'出现错误执行以下代码

Error:

MsgBox Err.Description, vbOKOnly, "Error Message"

End Sub

'在判定部分书写 定尺长度

Sub dc()

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

mystr_zj = "select * from JTQPu1Pd2 where mo= '" + CStr(Range("E3")) + "'"

myrs.Open mystr_zj

Range("T4") = Trim(myrs!dc)

'关闭连接

myrs.Close

myCn.Close

Exit Sub

'出现错误执行以下代码

Error:

MsgBox Err.Description, vbOKOnly, "Error Message"

End Sub

'写 入库部分数据

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单元格内容

Range("E10") = Range("E3")

Range("O10") = Range("O3")

Range("C9") = Range("C2")

mystr = "execute pu1rk_zhangzs '" + CStr(Range("E10")) + "'"

' mystr = "select top 1 * from mittra "

' MsgBox (mystr)

myrs.Open mystr '为 Recordset 赋值

'如果没有查出记录

If myrs.EOF Then

MsgBox "精整还没有入库!", vbOKOnly, "错误"

Exit Sub

End If

'为工作表解除保护

' Worksheets("精整入库").Unprotect Password:="zhangzs"

'插入所查询的数据

Range("R9") = Trim(myrs!交易日期)

Range("B10") = Trim(myrs!炉号)

Range("H10") = Trim(myrs!钢种)

Range("L10") = Trim(myrs!铸坯外径)

Range("T10") = Trim(myrs!定尺长度) + "m"

'Range("C13") = Trim(myrs!操作者)

n = 2 '初始变量

m = 11

Do While Not myrs.EOF

Cells(m, n + 1) = Trim(myrs!倍尺数)

Cells(m + 1, n + 1) = Trim(myrs!实际支数)

Cells(m + 2, n + 1) = Trim(myrs!重量)

myrs.MoveNext

n = n + 3

Loop

' Worksheets("精整入库").Protect Password:="zhangzs", DrawingObjects:=True, contents:=True, Scenarios:=True

'关闭连接

myrs.Close

myCn.Close

Exit Sub

'出现错误执行以下代码

Error:

MsgBox Err.Description, vbOKOnly, "Error Message"

End Sub

'对比结果显示

Sub Zj_Rk_Db()

' If Trim(Range("T4").Text) = Replace(Replace(Trim(Range("T10").Text), "m", ""), ".", "") + "0" Then

' Range("E16") = "OK"

' Range("E16").Font.ColorIndex = 10

' Range("E16").Font.Bold = True

' Else

' Range("E16") = "Error"

' Range("E16").Font.ColorIndex = 3

' Range("E16").Font.Bold = True

' End If

If Trim(Range("T5").Text) = Trim(Range("T11").Text) Then

Range("E17") = "OK"

Range("E17").Font.ColorIndex = 10

Range("E17").Font.Bold = True

Else

Range("E17") = "Error"

Range("E17").Font.ColorIndex = 3

Range("E17").Font.Bold = True

End If

If Trim(Range("T6").Text) = Trim(Range("T12").Text) Then

Range("E18") = "OK"

Range("E18").Font.ColorIndex = 10

Range("E18").Font.Bold = True

Else

Range("E18") = "Error"

Range("E18").Font.ColorIndex = 3

Range("E18").Font.Bold = True

End If

'批次跟踪

If Trim(Range("B3").Text) = Trim(Range("B10").Text) Then

Range("E19") = "OK"

Range("E19").Font.ColorIndex = 10

Range("E19").Font.Bold = True

Else

Range("E19") = "Error"

Range("E19").Font.ColorIndex = 3

Range("E19").Font.Bold = True

End If

End Sub

'清空记录

Sub Clear()

'判定部分清除

Range("C2") = ""

Range("R2") = ""

Range("E3") = ""

Range("H3") = ""

Range("L3") = ""

Range("O3") = ""

Range("T4") = ""

Range("T5") = ""

Range("T6") = ""

'入库部分清除

Range("C9") = ""

Range("R9") = ""

Range("B10") = ""

Range("H10") = ""

Range("O10") = ""

Range("L10") = ""

Range("E10") = ""

Range("T10") = ""

For i = 11 To 13

For j = 3 To 15

Cells(i, j) = ""

Next j

Next i

'清除对比结果

Range("E16") = ""

Range("E17") = ""

Range("E18") = ""

Range("E19") = ""

'清除库存交易历史内容

For i = 7 To 24

For j = 2 To 12

Worksheets("库存交易历史").Cells(i, j) = ""

Next j

Next i

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 2 And Target.Row = 3 Then

Call Clear

If Range("B3") <> "" Then

Call Pu1zj_write

'Call dc

Call Pu1rk_write

Call Zj_Rk_Db

Call Pu1_kucun_write

End If

End If

End Sub

Sub Pu1_kucun_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=man" 'DL580-1

On Error GoTo Error:

myCn.ConnectionString = strcon

'设置超时时间，为0时表示，将一直等待到命令执行完毕

myCn.CommandTimeout = 0

myCn.Open

myrs.ActiveConnection = myCn

mystr_zj = "execute pu1_kucun '" + CStr(Range("E10")) + "'"

myrs.Open mystr_zj

n = 2 '初始变量

m = 7

Do While Not myrs.EOF

Worksheets("库存交易历史").Cells(m, n) = Trim(myrs!操作者)

Worksheets("库存交易历史").Cells(m, n + 1) = Trim(myrs!物料号)

Worksheets("库存交易历史").Cells(m, n + 2) = Trim(myrs!订单号)

Worksheets("库存交易历史").Cells(m, n + 3) = Trim(myrs!炉号)

Worksheets("库存交易历史").Cells(m, n + 4) = Trim(myrs!倍尺数)

Worksheets("库存交易历史").Cells(m, n + 5) = Trim(myrs!入库重量)

Worksheets("库存交易历史").Cells(m, n + 6) = Trim(myrs!入库支数)

Worksheets("库存交易历史").Cells(m, n + 7) = Trim(myrs!实际支数)

Worksheets("库存交易历史").Cells(m, n + 8) = Trim(myrs!批号)

Worksheets("库存交易历史").Cells(m, n + 9) = Trim(myrs!库位)

Worksheets("库存交易历史").Cells(m, n + 10) = Trim(myrs!交易日期)

myrs.MoveNext

m = m + 1

Loop

'关闭连接

myrs.Close

myCn.Close

Exit Sub

'出现错误执行以下代码

Error:

MsgBox Err.Description, vbOKOnly, "Error Message"

End Sub

--图片：输入“炉号”后回车即可得到结果。

• ·利用JSP直接绘制图片并输出到IE里
• ·如何架设Samba服务器，用user共享方式【
• ·人力资源与压迫
• ·界面测试（转贴）
• ·Linux学习笔记－网络相关ping fing
• ·何时自动化系统测试
• ·利用JAVACC将HQL->SQL(1)
• ·java文件的相对路径
• ·弹指十年间(献给即将奔三十的人) [转载]
• ·DataWindow Style帮你格式化数据