CSDN博客

img zhangzs8896

PU1入库情况检查

发表于2004/9/19 15:28:00  548人阅读

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

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

--截图在相册里

 

0 0

相关博文

我的热门文章

img
取 消
img