TMP
TMP
Dim cqty
Private Sub btn_s_Click()
'判断各条件是否符合
If mb.Text = "" Then MsgBox "请选择主板料号！", vbCritical, "错误": mb.SetFocus: Exit Sub
If panelo.Text = "" Then MsgBox "请选择原屏料号！", vbCritical, "错误": panelo.SetFocus: Exit Sub
If paneln.Text = "" Then MsgBox "请选择新屏料号！", vbCritical, "错误": paneln.SetFocus: Exit Sub
If loc.Text = "" Then MsgBox "请选择库位！", vbCritical, "错误": loc.SetFocus: Exit Sub
If Replace(Split(panelo.Text, "/")(0), "-F", "") = Replace(paneln.Text, "-F", "") Then
MsgBox "原屏与新屏不能相同！", vbCritical, "提示"
Exit Sub
End If
btn_s.Enabled = False
btnOk.Enabled = False
FG1.Clear
FG1.Rows = 1
FG1.FixedRows = 0
FG1.AddItem " " & vbTab & "料号" & vbTab & "描述" & vbTab & "用量", 0
FG1.FixedRows = 1
FG2.Clear
FG2.Rows = 1
FG2.FixedRows = 0
FG2.AddItem " " & vbTab & "料号" & vbTab & "描述" & vbTab & "用量", 0
FG2.FixedRows = 1
'取该机型原屏配所选主板的逻辑关系物料
ConSQL
Set rs = CreateObject("adodb.recordset")
SQL = "select skd_comp,skd_qty_per,(select rtrim(pt_desc1)+rtrim(pt_desc2) from pt_mstr where pt_part=skd_comp) as skd_desc from skd_det where skd_model='" & md.Caption & "' and skd_pt_no1='" & Replace(Split(panelo.Text, "/")(0), "-F", "") & "' and skd_pt_no2='" & mb.Text & "'"
rs.Open SQL, ConnSQL, 1, 1
i = 1
Do While Not rs.EOF
FG1.AddItem " " & vbTab & Trim(rs("skd_comp")) & vbTab & rs("skd_desc") & vbTab & rs("skd_qty_per"), i
i = i + 1
rs.MoveNext
Loop
'取原屏共用料里的差异料
Set rs = CreateObject("adodb.recordset")
SQL = "select skps_comp,skps_qty_per,(select rtrim(pt_desc1)+rtrim(pt_desc2) from pt_mstr where pt_part=skps_comp) as skps_desc from skps_mstr where skps_model='" & md.Caption & "' and skps_part='" & Replace(Split(panelo.Text, "/")(0), "-F", "") & "'"
rs.Open SQL, ConnSQL, 1, 1
i = 1
Do While Not rs.EOF
FG1.AddItem " " & vbTab & Trim(rs("skps_comp")) & vbTab & rs("skps_desc") & vbTab & rs("skps_qty_per"), i
i = i + 1
rs.MoveNext
Loop
'取新屏的逻辑关系差异料
Set rs = CreateObject("adodb.recordset")
SQL = "select skd_comp,skd_qty_per,(select rtrim(pt_desc1)+rtrim(pt_desc2) from pt_mstr where pt_part=skd_comp) as skd_desc from skd_det where skd_model='" & md.Caption & "' and skd_pt_no1='" & Replace(paneln.Text, "-F", "") & "' and skd_pt_no2='" & mb.Text & "'"
rs.Open SQL, ConnSQL, 1, 1
i = 1
Do While Not rs.EOF
FG2.AddItem " " & vbTab & Trim(rs("skd_comp")) & vbTab & rs("skd_desc") & vbTab & rs("skd_qty_per"), i
i = i + 1
rs.MoveNext
Loop
'取新屏共用料里的差异料
Set rs = CreateObject("adodb.recordset")
SQL = "select skps_comp,skps_qty_per,(select rtrim(pt_desc1)+rtrim(pt_desc2) from pt_mstr where pt_part=skps_comp) as skps_desc from skps_mstr where skps_model='" & md.Caption & "' and skps_part='" & Replace(paneln.Text, "-F", "") & "'"
rs.Open SQL, ConnSQL, 1, 1
i = 1
Do While Not rs.EOF
FG2.AddItem " " & vbTab & Trim(rs("skps_comp")) & vbTab & rs("skps_desc") & vbTab & rs("skps_qty_per"), i
i = i + 1
rs.MoveNext
Loop
'给有差异的物料加颜色
'先把表1遍历一遍
For i = 0 To FG1.Rows - 2
tmp = 0
For j = 0 To FG2.Rows - 2
If FG1.TextMatrix(i, 1) = FG2.TextMatrix(j, 1) Then
tmp = 1
End If
Next j
If tmp = 0 Then FG1.Col = 1: FG1.Row = i: FG1.CellForeColor = vbRed: FG1.Col = 2: FG1.Row = i: FG1.CellForeColor = vbRed
Next i
'再把表2反过来遍历一遍
For i = 0 To FG2.Rows - 2
tmp = 0
For j = 0 To FG1.Rows - 2
If FG2.TextMatrix(i, 1) = FG1.TextMatrix(j, 1) Then
tmp = 1
End If
Next j
If tmp = 0 Then FG2.Col = 1: FG2.Row = i: FG2.CellForeColor = vbRed: FG2.Col = 2: FG2.Row = i: FG2.CellForeColor = vbRed
Next i
btn_s.Enabled = True
btnOk.Enabled = True
End Sub
Private Sub Btnok_Click()
If MsgBox(vbCrLf & "你确定要更改吗？" & vbCrLf & vbCrLf, vbInformation + vbOKCancel, "提示") = vbCancel Then Exit Sub
btnOk.Enabled = False
btn_s.Enabled = False
ConSQL
'判断变更数量是否大于原订单数
If Int(qty.Text) > Int(cqty) Then
MsgBox "更改数量不能大于订单数量！", vbCritical, "错误"
qty.SetFocus
btnOk.Enabled = True
btn_s.Enabled = True
Exit Sub
End If
'判断原屏数量是否够减
SQL = "select * from wod_det where wod_qty_req>=" & qty.Text & " and wod_nbr='" & wod_nbr.Text & "' and wod_part='" & Split(panelo.Text, "/")(0) & "'"
Set rs = CreateObject("adodb.recordset")
rs.Open SQL, ConnSQL, 1, 1
If rs.EOF Then
MsgBox "原屏在物料清单中需求量小于更改数，不可更改！", vbCritical, "错误"
btn_s.Enabled = True
Exit Sub
End If
'判断原屏差异料在物料清单中是否够减
For i = 1 To FG1.Rows - 2
FG1.Col = 1: FG1.Row = i
If FG1.CellForeColor = vbRed Then
SQL = "select * from wod_det where wod_qty_req>=" & qty.Text & "*" & FG1.TextMatrix(i, 3) & " and wod_nbr='" & wod_nbr.Text & "' and wod_part='" & FG1.TextMatrix(i, 1) & "'"
Set rs = CreateObject("adodb.recordset")
rs.Open SQL, ConnSQL, 1, 1
If rs.EOF Then
MsgBox "" & FG1.TextMatrix(i, 1) & " 在物料清单中需求量小于更改数，不可更改！", vbCritical, "错误"
btn_s.Enabled = True
Exit Sub
End If
End If
Next i
'变更原屏数量
SQL = "update wod_det set wod_qty_req=wod_qty_req-" & qty.Text & " where wod_nbr='" & wod_nbr.Text & "' and wod_part='" & Split(panelo.Text, "/")(0) & "'"
Set rs = CreateObject("adodb.recordset")
rs.Open SQL, ConnSQL, 1, 1
'判断是否有新屏料号
SQL = "select * from wod_det where wod_nbr='" & wod_nbr.Text & "' and wod_part='" & paneln.Text & "'"
Set rs = CreateObject("adodb.recordset")
rs.Open SQL, ConnSQL, 1, 1
If Not rs.EOF Then
'如有，直接加上数量
SQL = "update wod_det set wod_qty_req=wod_qty_req+" & qty.Text & " where wod_nbr='" & wod_nbr.Text & "' and wod_part='" & paneln.Text & "'"
Else
'如没有，则新加一行
SQL = "insert wod_det(wod_seq,wod_site,wod_nbr,wod_part,wod_loc,wod_qty_per,wod_qty_req,wod_due_date) "
SQL = SQL & "select (select max(wod_seq)+1 from wod_det where wod_nbr='" & wod_nbr.Text & "' and wod_part like '742%'),1010,'" & wod_nbr.Text & "','" & paneln.Text & "','" & loc.Text & "',1," & qty.Text & ",getdate()"
End If
Set rs = CreateObject("adodb.recordset")
rs.Open SQL, ConnSQL, 1, 1
'变更差异料内容
For i = 1 To FG1.Rows - 2
FG1.Col = 1: FG1.Row = i
'把原屏红色的物料数量减掉
If FG1.CellForeColor = vbRed Then
SQL = "update wod_det set wod_qty_req=wod_qty_req-" & qty.Text & "*" & FG1.TextMatrix(i, 3) & " where wod_nbr='" & wod_nbr.Text & "' and wod_part='" & FG1.TextMatrix(i, 1) & "'"
Set rs = CreateObject("adodb.recordset")
rs.Open SQL, ConnSQL, 1, 1
End If
Next i
For i = 1 To FG2.Rows - 2
FG2.Col = 1: FG2.Row = i
'判断新屏红色的物料是否存在
If FG2.CellForeColor = vbRed Then
SQL = "select * from wod_det where wod_nbr='" & wod_nbr.Text & "' and wod_part='" & FG2.TextMatrix(i, 1) & "'"
Set rs = CreateObject("adodb.recordset")
rs.Open SQL, ConnSQL, 1, 1
If Not rs.EOF Then
'如有，直接加上数量
SQL = "update wod_det set wod_qty_req=wod_qty_req+" & qty.Text & "*" & FG2.TextMatrix(i, 3) & " where wod_nbr='" & wod_nbr.Text & "' and wod_part='" & FG2.TextMatrix(i, 1) & "'"
Else
'如没有，则新加一行
SQL = "insert wod_det(wod_seq,wod_site,wod_nbr,wod_part,wod_loc,wod_qty_per,wod_qty_req,wod_due_date) "
SQL = SQL & "select (select isnull(max(wod_seq)+1,1) from wod_det where wod_nbr='" & wod_nbr.Text & "' and wod_seq<1000),1010,'" & wod_nbr.Text & "','" & FG2.TextMatrix(i, 1) & "',(select pt_loc_iss from pt_mstr where pt_part='" & FG2.TextMatrix(i, 1) & "')," & FG2.TextMatrix(i, 3) & "," & qty.Text * FG2.TextMatrix(i, 3) & ",getdate()"
End If
Set rs = CreateObject("adodb.recordset")
rs.Open SQL, ConnSQL, 1, 1
End If
Next i
MsgBox "更改成功，请到生产单物料清单里核对一遍！", vbInformation, "提示"
End Sub
Private Sub Form_Load()
FG1.Clear
FG1.Cols = 4
FG1.Rows = 1
FG1.FixedRows = 0
FG1.AddItem " " & vbTab & "料号" & vbTab & "描述" & vbTab & "用量", 0
FG1.FixedRows = 1
With FG1
.ColWidth(0) = 300
.ColWidth(1) = 1500
.ColWidth(2) = 5200
.ColWidth(3) = 500
For i = 0 To .Cols - 1
.FixedAlignment(i) = flexAlignLeftCenter
.ColAlignment(i) = flexAlignLeftCenter
Next
End With
FG2.Clear
FG2.Cols = 4
FG2.Rows = 1
FG2.FixedRows = 0
FG2.AddItem " " & vbTab & "料号" & vbTab & "描述" & vbTab & "用量", 0
FG2.FixedRows = 1
With FG2
.ColWidth(0) = 300
.ColWidth(1) = 1500
.ColWidth(2) = 5200
.ColWidth(3) = 500
For i = 0 To .Cols - 1
.FixedAlignment(i) = flexAlignLeftCenter
.ColAlignment(i) = flexAlignLeftCenter
Next
End With
tips.Caption = "使用说明：1.输生产单号；2.填写要更改的屏数量；3.选原屏料号；" & vbCrLf & "4.选新屏料号；5.选库位；6.计算差异料；7.确认无误后更改进物料清单。"
End Sub
Private Sub wod_nbr_LostFocus()
btnOk.Enabled = False
ConSQL
If Len(wod_nbr.Text) <> 0 Then
Set rs = CreateObject("adodb.recordset")
SQL = "select wo_qty_ord,(select pt_group from pt_mstr where pt_part=wo_part) as model from wo_mstr where wo_nbr = '" & Trim(wod_nbr.Text) & "' and wo_status<>'C'"
rs.Open SQL, ConnSQL, 1, 1
If rs.EOF Then
MsgBox "生产单不存在或已关闭！", vbCritical, "错误"
wod_nbr.SetFocus
Exit Sub
End If
Dim model
model = rs("model")
md.Caption = model
orderqty.Caption = "生产数量：" & rs(0)
cqty = rs(0)
mb.Clear
panelo.Clear
paneln.Clear
Set rs = CreateObject("adodb.recordset")
SQL = "select * from wod_det where wod_nbr = '" & Trim(wod_nbr.Text) & "' and (wod_part like '941-11%' or wod_part like '742%') and wod_qty_req>0"
rs.Open SQL, ConnSQL, 1, 1
Do While Not rs.EOF
'把主板加进下拉框
If Left(rs("wod_part"), 3) = "941" Then
mb.AddItem (Trim(rs("wod_part")))
End If
'把屏加进下拉框
If Left(rs("wod_part"), 3) = "742" Then
panelo.AddItem (Trim(rs("wod_part")) & "/" & rs("wod_loc"))
End If
rs.MoveNext
Loop
If mb.ListCount > 0 Then mb.ListIndex = 0
If panelo.ListCount > 0 Then panelo.ListIndex = 0
'根据机型和主板，取该机型在逻辑关系里维护的屏，加进新屏的下拉框
Set rs = CreateObject("adodb.recordset")
SQL = "select distinct sk_pt_no1 from sk_mstr where sk_model='" & model & "' and sk_pt_no2 in(select wod_part from wod_det where wod_nbr='" & Trim(wod_nbr.Text) & "' and wod_part like '941-11%')"
rs.Open SQL, ConnSQL, 1, 1
Do While Not rs.EOF
paneln.AddItem (Trim(rs("sk_pt_no1")))
rs.MoveNext
Loop
End If
btn_s.Enabled = True
End Sub
Private Sub btn_s_Click()
'判断各条件是否符合
If mb.Text = "" Then MsgBox "请选择主板料号！", vbCritical, "错误": mb.SetFocus: Exit Sub
If panelo.Text = "" Then MsgBox "请选择原屏料号！", vbCritical, "错误": panelo.SetFocus: Exit Sub
If paneln.Text = "" Then MsgBox "请选择新屏料号！", vbCritical, "错误": paneln.SetFocus: Exit Sub
If loc.Text = "" Then MsgBox "请选择库位！", vbCritical, "错误": loc.SetFocus: Exit Sub
If Replace(Split(panelo.Text, "/")(0), "-F", "") = Replace(paneln.Text, "-F", "") Then
MsgBox "原屏与新屏不能相同！", vbCritical, "提示"
Exit Sub
End If
btn_s.Enabled = False
btnOk.Enabled = False
FG1.Clear
FG1.Rows = 1
FG1.FixedRows = 0
FG1.AddItem " " & vbTab & "料号" & vbTab & "描述" & vbTab & "用量", 0
FG1.FixedRows = 1
FG2.Clear
FG2.Rows = 1
FG2.FixedRows = 0
FG2.AddItem " " & vbTab & "料号" & vbTab & "描述" & vbTab & "用量", 0
FG2.FixedRows = 1
'取该机型原屏配所选主板的逻辑关系物料
ConSQL
Set rs = CreateObject("adodb.recordset")
SQL = "select skd_comp,skd_qty_per,(select rtrim(pt_desc1)+rtrim(pt_desc2) from pt_mstr where pt_part=skd_comp) as skd_desc from skd_det where skd_model='" & md.Caption & "' and skd_pt_no1='" & Replace(Split(panelo.Text, "/")(0), "-F", "") & "' and skd_pt_no2='" & mb.Text & "'"
rs.Open SQL, ConnSQL, 1, 1
i = 1
Do While Not rs.EOF
FG1.AddItem " " & vbTab & Trim(rs("skd_comp")) & vbTab & rs("skd_desc") & vbTab & rs("skd_qty_per"), i
i = i + 1
rs.MoveNext
Loop
'取原屏共用料里的差异料
Set rs = CreateObject("adodb.recordset")
SQL = "select skps_comp,skps_qty_per,(select rtrim(pt_desc1)+rtrim(pt_desc2) from pt_mstr where pt_part=skps_comp) as skps_desc from skps_mstr where skps_model='" & md.Caption & "' and skps_part='" & Replace(Split(panelo.Text, "/")(0), "-F", "") & "'"
rs.Open SQL, ConnSQL, 1, 1
i = 1
Do While Not rs.EOF
FG1.AddItem " " & vbTab & Trim(rs("skps_comp")) & vbTab & rs("skps_desc") & vbTab & rs("skps_qty_per"), i
i = i + 1
rs.MoveNext
Loop
'取新屏的逻辑关系差异料
Set rs = CreateObject("adodb.recordset")
SQL = "select skd_comp,skd_qty_per,(select rtrim(pt_desc1)+rtrim(pt_desc2) from pt_mstr where pt_part=skd_comp) as skd_desc from skd_det where skd_model='" & md.Caption & "' and skd_pt_no1='" & Replace(paneln.Text, "-F", "") & "' and skd_pt_no2='" & mb.Text & "'"
rs.Open SQL, ConnSQL, 1, 1
i = 1
Do While Not rs.EOF
FG2.AddItem " " & vbTab & Trim(rs("skd_comp")) & vbTab & rs("skd_desc") & vbTab & rs("skd_qty_per"), i
i = i + 1
rs.MoveNext
Loop
'取新屏共用料里的差异料
Set rs = CreateObject("adodb.recordset")
SQL = "select skps_comp,skps_qty_per,(select rtrim(pt_desc1)+rtrim(pt_desc2) from pt_mstr where pt_part=skps_comp) as skps_desc from skps_mstr where skps_model='" & md.Caption & "' and skps_part='" & Replace(paneln.Text, "-F", "") & "'"
rs.Open SQL, ConnSQL, 1, 1
i = 1
Do While Not rs.EOF
FG2.AddItem " " & vbTab & Trim(rs("skps_comp")) & vbTab & rs("skps_desc") & vbTab & rs("skps_qty_per"), i
i = i + 1
rs.MoveNext
Loop
'给有差异的物料加颜色
'先把表1遍历一遍
For i = 0 To FG1.Rows - 2
tmp = 0
For j = 0 To FG2.Rows - 2
If FG1.TextMatrix(i, 1) = FG2.TextMatrix(j, 1) Then
tmp = 1
End If
Next j
If tmp = 0 Then FG1.Col = 1: FG1.Row = i: FG1.CellForeColor = vbRed: FG1.Col = 2: FG1.Row = i: FG1.CellForeColor = vbRed
Next i
'再把表2反过来遍历一遍
For i = 0 To FG2.Rows - 2
tmp = 0
For j = 0 To FG1.Rows - 2
If FG2.TextMatrix(i, 1) = FG1.TextMatrix(j, 1) Then
tmp = 1
End If
Next j
If tmp = 0 Then FG2.Col = 1: FG2.Row = i: FG2.CellForeColor = vbRed: FG2.Col = 2: FG2.Row = i: FG2.CellForeColor = vbRed
Next i
btn_s.Enabled = True
btnOk.Enabled = True
End Sub
Private Sub Btnok_Click()
If MsgBox(vbCrLf & "你确定要更改吗？" & vbCrLf & vbCrLf, vbInformation + vbOKCancel, "提示") = vbCancel Then Exit Sub
btnOk.Enabled = False
btn_s.Enabled = False
ConSQL
'判断变更数量是否大于原订单数
If Int(qty.Text) > Int(cqty) Then
MsgBox "更改数量不能大于订单数量！", vbCritical, "错误"
qty.SetFocus
btnOk.Enabled = True
btn_s.Enabled = True
Exit Sub
End If
'判断原屏数量是否够减
SQL = "select * from wod_det where wod_qty_req>=" & qty.Text & " and wod_nbr='" & wod_nbr.Text & "' and wod_part='" & Split(panelo.Text, "/")(0) & "'"
Set rs = CreateObject("adodb.recordset")
rs.Open SQL, ConnSQL, 1, 1
If rs.EOF Then
MsgBox "原屏在物料清单中需求量小于更改数，不可更改！", vbCritical, "错误"
btn_s.Enabled = True
Exit Sub
End If
'判断原屏差异料在物料清单中是否够减
For i = 1 To FG1.Rows - 2
FG1.Col = 1: FG1.Row = i
If FG1.CellForeColor = vbRed Then
SQL = "select * from wod_det where wod_qty_req>=" & qty.Text & "*" & FG1.TextMatrix(i, 3) & " and wod_nbr='" & wod_nbr.Text & "' and wod_part='" & FG1.TextMatrix(i, 1) & "'"
Set rs = CreateObject("adodb.recordset")
rs.Open SQL, ConnSQL, 1, 1
If rs.EOF Then
MsgBox "" & FG1.TextMatrix(i, 1) & " 在物料清单中需求量小于更改数，不可更改！", vbCritical, "错误"
btn_s.Enabled = True
Exit Sub
End If
End If
Next i
'变更原屏数量
SQL = "update wod_det set wod_qty_req=wod_qty_req-" & qty.Text & " where wod_nbr='" & wod_nbr.Text & "' and wod_part='" & Split(panelo.Text, "/")(0) & "'"
Set rs = CreateObject("adodb.recordset")
rs.Open SQL, ConnSQL, 1, 1
'判断是否有新屏料号
SQL = "select * from wod_det where wod_nbr='" & wod_nbr.Text & "' and wod_part='" & paneln.Text & "'"
Set rs = CreateObject("adodb.recordset")
rs.Open SQL, ConnSQL, 1, 1
If Not rs.EOF Then
'如有，直接加上数量
SQL = "update wod_det set wod_qty_req=wod_qty_req+" & qty.Text & " where wod_nbr='" & wod_nbr.Text & "' and wod_part='" & paneln.Text & "'"
Else
'如没有，则新加一行
SQL = "insert wod_det(wod_seq,wod_site,wod_nbr,wod_part,wod_loc,wod_qty_per,wod_qty_req,wod_due_date) "
SQL = SQL & "select (select max(wod_seq)+1 from wod_det where wod_nbr='" & wod_nbr.Text & "' and wod_part like '742%'),1010,'" & wod_nbr.Text & "','" & paneln.Text & "','" & loc.Text & "',1," & qty.Text & ",getdate()"
End If
Set rs = CreateObject("adodb.recordset")
rs.Open SQL, ConnSQL, 1, 1
'变更差异料内容
For i = 1 To FG1.Rows - 2
FG1.Col = 1: FG1.Row = i
'把原屏红色的物料数量减掉
If FG1.CellForeColor = vbRed Then
SQL = "update wod_det set wod_qty_req=wod_qty_req-" & qty.Text & "*" & FG1.TextMatrix(i, 3) & " where wod_nbr='" & wod_nbr.Text & "' and wod_part='" & FG1.TextMatrix(i, 1) & "'"
Set rs = CreateObject("adodb.recordset")
rs.Open SQL, ConnSQL, 1, 1
End If
Next i
For i = 1 To FG2.Rows - 2
FG2.Col = 1: FG2.Row = i
'判断新屏红色的物料是否存在
If FG2.CellForeColor = vbRed Then
SQL = "select * from wod_det where wod_nbr='" & wod_nbr.Text & "' and wod_part='" & FG2.TextMatrix(i, 1) & "'"
Set rs = CreateObject("adodb.recordset")
rs.Open SQL, ConnSQL, 1, 1
If Not rs.EOF Then
'如有，直接加上数量
SQL = "update wod_det set wod_qty_req=wod_qty_req+" & qty.Text & "*" & FG2.TextMatrix(i, 3) & " where wod_nbr='" & wod_nbr.Text & "' and wod_part='" & FG2.TextMatrix(i, 1) & "'"
Else
'如没有，则新加一行
SQL = "insert wod_det(wod_seq,wod_site,wod_nbr,wod_part,wod_loc,wod_qty_per,wod_qty_req,wod_due_date) "
SQL = SQL & "select (select isnull(max(wod_seq)+1,1) from wod_det where wod_nbr='" & wod_nbr.Text & "' and wod_seq<1000),1010,'" & wod_nbr.Text & "','" & FG2.TextMatrix(i, 1) & "',(select pt_loc_iss from pt_mstr where pt_part='" & FG2.TextMatrix(i, 1) & "')," & FG2.TextMatrix(i, 3) & "," & qty.Text * FG2.TextMatrix(i, 3) & ",getdate()"
End If
Set rs = CreateObject("adodb.recordset")
rs.Open SQL, ConnSQL, 1, 1
End If
Next i
MsgBox "更改成功，请到生产单物料清单里核对一遍！", vbInformation, "提示"
End Sub
Private Sub Form_Load()
FG1.Clear
FG1.Cols = 4
FG1.Rows = 1
FG1.FixedRows = 0
FG1.AddItem " " & vbTab & "料号" & vbTab & "描述" & vbTab & "用量", 0
FG1.FixedRows = 1
With FG1
.ColWidth(0) = 300
.ColWidth(1) = 1500
.ColWidth(2) = 5200
.ColWidth(3) = 500
For i = 0 To .Cols - 1
.FixedAlignment(i) = flexAlignLeftCenter
.ColAlignment(i) = flexAlignLeftCenter
Next
End With
FG2.Clear
FG2.Cols = 4
FG2.Rows = 1
FG2.FixedRows = 0
FG2.AddItem " " & vbTab & "料号" & vbTab & "描述" & vbTab & "用量", 0
FG2.FixedRows = 1
With FG2
.ColWidth(0) = 300
.ColWidth(1) = 1500
.ColWidth(2) = 5200
.ColWidth(3) = 500
For i = 0 To .Cols - 1
.FixedAlignment(i) = flexAlignLeftCenter
.ColAlignment(i) = flexAlignLeftCenter
Next
End With
tips.Caption = "使用说明：1.输生产单号；2.填写要更改的屏数量；3.选原屏料号；" & vbCrLf & "4.选新屏料号；5.选库位；6.计算差异料；7.确认无误后更改进物料清单。"
End Sub
Private Sub wod_nbr_LostFocus()
btnOk.Enabled = False
ConSQL
If Len(wod_nbr.Text) <> 0 Then
Set rs = CreateObject("adodb.recordset")
SQL = "select wo_qty_ord,(select pt_group from pt_mstr where pt_part=wo_part) as model from wo_mstr where wo_nbr = '" & Trim(wod_nbr.Text) & "' and wo_status<>'C'"
rs.Open SQL, ConnSQL, 1, 1
If rs.EOF Then
MsgBox "生产单不存在或已关闭！", vbCritical, "错误"
wod_nbr.SetFocus
Exit Sub
End If
Dim model
model = rs("model")
md.Caption = model
orderqty.Caption = "生产数量：" & rs(0)
cqty = rs(0)
mb.Clear
panelo.Clear
paneln.Clear
Set rs = CreateObject("adodb.recordset")
SQL = "select * from wod_det where wod_nbr = '" & Trim(wod_nbr.Text) & "' and (wod_part like '941-11%' or wod_part like '742%') and wod_qty_req>0"
rs.Open SQL, ConnSQL, 1, 1
Do While Not rs.EOF
'把主板加进下拉框
If Left(rs("wod_part"), 3) = "941" Then
mb.AddItem (Trim(rs("wod_part")))
End If
'把屏加进下拉框
If Left(rs("wod_part"), 3) = "742" Then
panelo.AddItem (Trim(rs("wod_part")) & "/" & rs("wod_loc"))
End If
rs.MoveNext
Loop
If mb.ListCount > 0 Then mb.ListIndex = 0
If panelo.ListCount > 0 Then panelo.ListIndex = 0
'根据机型和主板，取该机型在逻辑关系里维护的屏，加进新屏的下拉框
Set rs = CreateObject("adodb.recordset")
SQL = "select distinct sk_pt_no1 from sk_mstr where sk_model='" & model & "' and sk_pt_no2 in(select wod_part from wod_det where wod_nbr='" & Trim(wod_nbr.Text) & "' and wod_part like '941-11%')"
rs.Open SQL, ConnSQL, 1, 1
Do While Not rs.EOF
paneln.AddItem (Trim(rs("sk_pt_no1")))
rs.MoveNext
Loop
End If
btn_s.Enabled = True
End Sub
浙公网安备 33010602011771号