PU1入库情况检查

最新推荐文章于 2024-11-09 21:51:58 发布

zhangzs8896

最新推荐文章于 2024-11-09 21:51:58 发布

阅读量833

点赞数

分类专栏： Office 开发文章标签： string 数据库相册 c 存储工作

本文链接：https://blog.csdn.net/zhangzs8896/article/details/109581

版权

Office 开发专栏收录该内容

3 篇文章 0 订阅

订阅专栏

'写判定部分数据
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