sc_lltz_djb.frm

基于SQL2000的企业管理MRPII,包含进销存,财务,报关等组件,VB6开发,带文档说明.

     bh = "0001"
  Else
  LLdH_Ado.MoveLast
  bhx = Trim(Str(Val(Right(LLdH_Ado.Fields("lldh").Value, 4)) + 1))
  If Len(bhx) = 1 Then
   bh = "000" & bhx
  End If
  If Len(bhx) = 2 Then
    bh = "00" + bhx
  End If
  If Len(bhx) = 3 Then
   bh = "0" + bhx
  End If
  If Len(bhx) >= 4 Then
  bh = bhx
  End If
End If
 With AdoprimaryRs.Recordset
      If .RecordCount > 0 Then
         .MoveLast
      End If
      .AddNew
For i = 0 To Text1.Count - 1
  Text1(i).Locked = False
Next i
For i = 0 To Combo.Count - 1
  Combo(i).Locked = False
Next i
  Text1(0).Text = "LL" & ni & yue & bh
  .Fields("djrq").Value = VBA.Date
  Combo(0).Text = "生产领料"
If Not (.BOF And .EOF) Then
   mvBookMark = .Bookmark
End If
End With
Call Xz_CoM
End Sub
Private Sub cmdDelete_Click() '删除
 If MsgBox("是否真的删除当前记录 ？", vbYesNo + 32, "系统提示") = vbYes Then
  On Error Resume Next
  Call Xg_Com
   DB.Execute "delete from sc_lltz_B where lldh='" & Trim(Text1(0).Text) & "'"
  Adodc_body_general.Recordset.UpdateBatch adAffectAll
  DB.Execute "delete from sc_lltz_H where lldh='" & Trim(Text1(0).Text) & "'"
  AdoprimaryRs.Refresh
  Adodc_body_general.Refresh
  End If
End Sub
Private Sub cmdEdit_Click() '编辑
 On Error GoTo EditErr
 TDBGrid1.AllowAddNew = True
 TDBGrid1.AllowDelete = True
 TDBGrid1.AllowUpdate = True
  For i = 0 To Text1.Count - 1
      Text1(i).Locked = False
  Next i
  For i = 0 To Combo.Count - 1
      Combo(i).Locked = False
  Next i
  CmD_SH.Enabled = False
  CmD_FinD.Enabled = False
  Cmddelete.Enabled = False
  Cmdadd.Enabled = False
  Cmdedit.Enabled = False
  Cmdreturn.Enabled = False
  CmdOK.Enabled = True
  Cmdcancel.Enabled = True
  cmdxq.Enabled = False
  cmdnext.Enabled = False
  cmdmd.Enabled = False
  cmdqd.Enabled = False
  Cmdprint.Enabled = False
  TDBGrid3.Enabled = False
  Call Xg_Com
  Exit Sub
EditErr:
  MsgBox Err.Description
End Sub
Private Sub cmdCancel_Click() '取消
  On Error Resume Next
  If Tjbz = True Then
  DB.Execute "delete from sc_lltz_B where lldh='" & Trim(Text1(0).Text) & "'"
  Adodc_body_general.Recordset.UpdateBatch adAffectAll
  End If
  Tjbz = False
  For i = 0 To Text1.Count - 1
      Text1(i).Locked = True
  Next i
  For i = 0 To Combo.Count - 1
      Combo(i).Locked = True
  Next i
  TDBGrid2.Visible = False
  TDBGrid1.AllowDelete = False
  TDBGrid1.AllowUpdate = False
  CmD_SH.Enabled = True
  CmD_FinD.Enabled = True
  Cmdprint.Enabled = True
  TDBGrid3.Enabled = True
  cmdxq.Enabled = True
  cmdnext.Enabled = True
  cmdmd.Enabled = True
  cmdqd.Enabled = True
  Cmddelete.Enabled = True
  Cmdadd.Enabled = True
  Cmdedit.Enabled = True
  Cmdreturn.Enabled = True
  CmdOK.Enabled = False
  Cmdcancel.Enabled = False
  AdoprimaryRs.Recordset.CancelUpdate
  If mvBookMark > 0 Then
    AdoprimaryRs.Recordset.Bookmark = mvBookMark
  Else
    AdoprimaryRs.Recordset.MoveFirst
  End If
  Tjbz = False
  Call Xg_Com
End Sub
Private Sub cmdOK_Click()    '确认
 On Error GoTo UpdateErr
  For i = 0 To Text1.Count - 1
      Text1(i).Locked = True
  Next i
  For i = 0 To Combo.Count - 1
      Combo(i).Locked = True
  Next i
  Tjbz = False
  TDBGrid1.AllowAddNew = False
  TDBGrid1.AllowDelete = False
  TDBGrid1.AllowUpdate = False
  TDBGrid2.Visible = False
  CmD_SH.Enabled = True
  CmD_FinD.Enabled = True
  Cmdprint.Enabled = True
  TDBGrid3.Enabled = True
  Cmddelete.Enabled = True
  Cmdadd.Enabled = True
  Cmdedit.Enabled = True
  Cmdreturn.Enabled = True
  CmdOK.Enabled = False
  cmdxq.Enabled = True
  cmdnext.Enabled = True
  cmdmd.Enabled = True
  cmdqd.Enabled = True
  Cmdcancel.Enabled = False
  Adodc_body_general.Recordset.UpdateBatch adAffectAll
  AdoprimaryRs.Recordset.UpdateBatch adAffectAll
  If AdoprimaryRs.Recordset.BOF = False Then
    AdoprimaryRs.Recordset.MovePrevious
    AdoprimaryRs.Recordset.MoveNext
  End If
  If AdoprimaryRs.Recordset.BOF = True Then
    AdoprimaryRs.Recordset.MoveNext
    AdoprimaryRs.Recordset.MovePrevious
  End If
  DB.Execute "delete from sc_lltz_B where lldh='' or lldh is null"
  Call Qr_Com
  Exit Sub
UpdateErr:
  MsgBox Err.Description
End Sub
Private Sub Combo_Click(Index As Integer) '自动导入需求物料
On Error Resume Next
If Check2.Value = 0 Then
If Index = 3 And Cmdadd.Enabled = False Then
   If Adodc_body_general.Recordset.RecordCount <= 0 Then
   Dr_STR = "SELECT * from sc_zztz_wlb where zzdh='" & Combo(3).Text & "' and ll_qk<>'已领完'"
   Set Dr_ZZtZ = New Recordset
   Dr_ZZtZ.Open Dr_STR, DB, adOpenStatic, adLockReadOnly
If Dr_ZZtZ.RecordCount > 0 Then
   Dr_ZZtZ.MoveFirst
   For i = 1 To Dr_ZZtZ.RecordCount
   Call YL_SL
   Call Yl_KcSl_TJ
   DB.Execute "insert into sc_lltz_B( lldh,yl_cplb,ylbh, ylmc, caizh, gg, yanse, dw, Sl, bMMC, YLSL, KCSL, SYSL, zzdh,ddbh, jhdh, khbh, cpbh,cpmc,cp_gg, cp_caizh, cp_yanse, cp_dw, cp_sl) values('" & Text1(0).Text & "'," & _
  "'" & Dr_ZZtZ!yl_CPLB & "','" & Dr_ZZtZ!ylbh & "','" & Dr_ZZtZ!ylmc & "','" & Dr_ZZtZ!yl_caizh & "','" & Dr_ZZtZ!yl_gg & "','" & Dr_ZZtZ!yl_yanse & "','" & Dr_ZZtZ!yl_dw & "',0,'" & Combo(1).Text & "'," & YLSL_Tj & " ," & Y_KcSL & ",'" & Dr_ZZtZ!SYSL & "','" & Dr_ZZtZ!zzdh & "','" & Dr_ZZtZ!ddbh & "','" & Dr_ZZtZ!jhdh & "','" & Dr_ZZtZ!khbh & "','" & Dr_ZZtZ!cpbh & "'" & _
  " ,'" & Dr_ZZtZ!cpmc & "','" & Dr_ZZtZ!gg & "','" & Dr_ZZtZ!caizh & "','" & Dr_ZZtZ!yanse & "','" & Dr_ZZtZ!dw & "','" & Dr_ZZtZ!Sl & "')"
   Dr_ZZtZ.MoveNext
Next i
End If
Else
Exit Sub
End If
Adodc_body_general.Recordset.Requery
End If
End If
End Sub
Private Sub combo_KeyPress(Index As Integer, KeyAscii As Integer)
   If KeyAscii = 13 Then    ' 按回车
      KeyAscii = 0
      SendKeys "{TAB}"
   End If
End Sub
Private Sub CMd_Find_Click() '查询按钮
On Error Resume Next
Set CX_FrM_SjY = Sc_LLtZ_DjB.AdoprimaryRs
CX_SJy = "select * from sc_lltz_H where not lldh is null  "
With SEC_Dialog
  .Combo1(0).Clear
  .Combo1(1).Clear
  .Combo1(0).AddItem ("lldh(领料单号）")
  .Combo1(1).AddItem ("lldh(领料单号）")
  .Combo1(0).AddItem ("zzdh(制令单号）")
  .Combo1(1).AddItem ("zzdh(制令单号）")
  .Combo1(0).AddItem ("bmmc(领料部门）")
  .Combo1(1).AddItem ("bmmc(领料部门）")
  .Combo1(0).AddItem ("lllx(领料类型）")
  .Combo1(1).AddItem ("lllx(领料类型）")
End With
Load SEC_Dialog
SEC_Dialog.Show 1
End Sub
Private Sub DTPicker1_Change() '按日期查询
If Check1.Value = 0 Then
  AdoprimaryRs.ConnectionString = Conn_Str
  AdoprimaryRs.RecordSource = "SELECT * FROM sc_lltz_H WHERE YEAR(djRQ)='" & DTPicker1.Year & "' AND MONTH(djRQ)='" & DTPicker1.Month & "' ORDER BY lldh"
Else
  AdoprimaryRs.ConnectionString = Conn_Str
  AdoprimaryRs.RecordSource = "SELECT * FROM sc_lltz_H WHERE djRQ='" & DTPicker1.Value & "' order BY lldh"
End If
AdoprimaryRs.Refresh
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) '非法退出禁止
If Cmdcancel.Enabled = True Then
   If UnloadMode <> VBRUN.QueryUnloadConstants.vbFormCode Then
   Cancel = 1
   Exit Sub
   End If
End If
End Sub
Private Sub Com_Load() '下拉组合框值生成
 On Error Resume Next
 Set Combo5_Data = New Recordset
 Combo5_Data.Open "select DISTINCT zzdh from sc_zztz_wlB where ll_qk='未领完'", DB, adOpenStatic
 If Combo5_Data.RecordCount > 0 Then
   For i = 1 To Combo5_Data.RecordCount
     Combo(3).AddItem (Combo5_Data.Fields("zzdh"))
    If Combo5_Data.EOF = False Then
     Combo5_Data.MoveNext
   End If
   Next i
 End If
 Set Combo6_Data = New Recordset
 Combo6_Data.Open "select DISTINCT bmmc from sys_bmsz", DB, adOpenStatic
 If Combo6_Data.RecordCount > 0 Then
   For i = 1 To Combo6_Data.RecordCount
     Combo(1).AddItem (Combo6_Data.Fields("bmmc"))
    If Combo6_Data.EOF = False Then
     Combo6_Data.MoveNext
   End If
   Next i
 End If
 Set Combo7 = New Recordset
 Combo7.Open "select DISTINCT name from sys_gzry", DB, adOpenStatic
 If Combo7.RecordCount > 0 Then
   For i = 1 To Combo7.RecordCount
     Combo(2).AddItem (Combo7.Fields("name"))
    If Combo7.EOF = False Then
     Combo7.MoveNext
   End If
   Next i
 End If
End Sub
Private Sub YL_SL() '自动核算制造单领料情况
On Error Resume Next
Set Ado_WLCx = New Recordset
Ado_WLCx.Open "select sum(sl) as Ylsl from sc_lltz_b where ylbh='" & Dr_ZZtZ!ylbh & "' and  ylmc='" & Dr_ZZtZ!ylmc & "' and caizh='" & Dr_ZZtZ!yl_caizh & "' and gg='" & Dr_ZZtZ!yl_gg & "'and yanse='" & Dr_ZZtZ!yl_yanse & "'and dw='" & Dr_ZZtZ!yl_dw & "' and zzdh='" & Dr_ZZtZ!zzdh & "' and ddbh='" & Dr_ZZtZ!ddbh & "' and jhdh='" & Dr_ZZtZ!jhdh & "' and khbh='" & Dr_ZZtZ!khbh & "' and cpbh='" & Dr_ZZtZ!cpbh & "' and cpmc='" & Dr_ZZtZ!cpmc & "' and cp_gg='" & Dr_ZZtZ!gg & "' and cp_caizh='" & Dr_ZZtZ!caizh & "' and cp_yanse='" & Dr_ZZtZ!yanse & "' and cp_dw='" & Dr_ZZtZ!dw & "'", DB, adOpenStatic, adLockReadOnly
Ado_WLCx.MoveFirst
If Ado_WLCx.RecordCount > 0 And Not IsNull(Ado_WLCx!YLSL) Then
YLSL_Tj = Ado_WLCx!YLSL
Else
YLSL_Tj = 0
End If
End Sub
Private Sub Sd_YL_SL() '手动核算制造单领料情况
On Error Resume Next
Set Ado_WLCx = New Recordset
Ado_WLCx.Open "select sum(sl) as Ylsl from sc_lltz_b where ylbh='" & Ado_cpxx.Recordset!cpbh_s & "' and  ylmc='" & Ado_cpxx.Recordset!cpmc & "' and caizh='" & Ado_cpxx.Recordset!caizh & "' and gg='" & Ado_cpxx.Recordset!gg & "'and yanse='" & Ado_cpxx.Recordset!yanse & "'and dw='" & Ado_cpxx.Recordset!dw & "' and zzdh='" & Trim(Combo(3).Text) & "'", DB, adOpenStatic, adLockReadOnly
Ado_WLCx.MoveFirst
If Ado_WLCx.RecordCount > 0 And Not IsNull(Ado_WLCx!YLSL) Then
YLSL_Tj = Ado_WLCx!YLSL
Else
YLSL_Tj = 0
End If
End Sub
Sub Xg_Com() '修改制令单领料标志
On Error Resume Next
With Adodc_body_general.Recordset
  If .RecordCount > 0 Then
  .MoveFirst
  For i = 1 To .RecordCount
  DB.Execute "update sc_zztz_wlb set ll_QK='未领完' where zzdh='" & .Fields("zzdh").Value & "' and cpbh='" & .Fields("cpbh").Value & "' and cpmc='" & .Fields("cpmc").Value & "' and caizh='" & .Fields("cp_caizh").Value & "' and yanse='" & .Fields("cp_yanse").Value & "'and dw='" & .Fields("cp_dw").Value & "'and ylbh='" & .Fields("ylbh").Value & "'and ylmc='" & .Fields("ylmc").Value & "'"
 .MoveNext
  Next i
  End If
End With
End Sub
Sub Qr_Com() '确认制令单领料标志
On Error Resume Next
With Adodc_body_general.Recordset
If .RecordCount > 0 Then
  .MoveFirst
  For i = 1 To .RecordCount
  If .Fields("ylsl").Value + .Fields("sl").Value >= .Fields("sysl").Value Then
    DB.Execute "update sc_zztz_wlb set ll_QK='已领完' where zzdh='" & .Fields("zzdh").Value & "' and cpbh='" & .Fields("cpbh").Value & "' and cpmc='" & .Fields("cpmc").Value & "' and caizh='" & .Fields("cp_caizh").Value & "' and yanse='" & .Fields("cp_yanse").Value & "' and dw='" & .Fields("cp_dw").Value & "' and ylbh='" & .Fields("ylbh").Value & "'and ylmc='" & .Fields("ylmc").Value & "'"
  End If
  If .Fields("ylsl").Value + .Fields("sl").Value < .Fields("sysl").Value Then
  DB.Execute "update sc_zztz_wlb set ll_QK='未领完' where zzdh='" & .Fields("zzdh").Value & "' and cpbh='" & .Fields("cpbh").Value & "' and cpmc='" & .Fields("cpmc").Value & "' and caizh='" & .Fields("cp_caizh").Value & "' and yanse='" & .Fields("cp_yanse").Value & "'and dw='" & .Fields("cp_dw").Value & "' and ylbh='" & .Fields("ylbh").Value & "'and ylmc='" & .Fields("ylmc").Value & "'"
  End If
  .MoveNext
  Next i
End If
End With
End Sub
Sub Xz_CoM()
 Dim ZZdH_str As String
 Set Combo5_Data = New Recordset
 Combo(3).Clear
 Combo5_Data.Open "select DISTINCT zzdh from sc_zztz_wlB where ll_qk='未领完'", DB, adOpenStatic
 If Combo5_Data.RecordCount > 0 Then
   For i = 1 To Combo5_Data.RecordCount
     Combo(3).AddItem (Combo5_Data.Fields("zzdh"))
    If Combo5_Data.EOF = False Then
     Combo5_Data.MoveNext
   End If
   Next i
 End If
End Sub
Sub Yl_KcSl_TJ()
Set Ado_KcTJ = New Recordset
Ado_KcTJ.Open "select isnull(sl,0) as kcsl from ck_yl_hzk where cplb='" & Dr_ZZtZ!yl_CPLB & "' and cpbh='" & Dr_ZZtZ!ylbh & "' and cpmc='" & Dr_ZZtZ!ylmc & "' and caizh='" & Dr_ZZtZ!yl_caizh & "' and gg='" & Dr_ZZtZ!yl_gg & "' and yanse='" & Dr_ZZtZ!yl_yanse & "' and dw='" & Dr_ZZtZ!yl_dw & "'", DB, adOpenStatic, adLockReadOnly
If Ado_KcTJ.RecordCount > 0 Then
Ado_KcTJ.MoveFirst
  If Not IsNull(Ado_KcTJ!kcsl) Then
  Y_KcSL = Ado_KcTJ!kcsl
  Else
  Y_KcSL = 0
  End If
  Else
  Y_KcSL = 0
End If
End Sub