收货登记查询.frm

部门在用的用户申告系统

   Data1.Recordset.Delete
   If Data1.Recordset.RecordCount = 0 Then
      Cmddel.Enabled = False
      Cmdupdate.Enabled = False
   End If
   MousePointer = vbDefault
   Cmdsm3.Text = ""
   Cmdjm3.Text = ""
   Cmdbjmc3.Text = ""
   Txtshxx3.Text = ""
   DTPick4.Value = Date
   Txtsl3.Text = ""
End If
Exit Sub

err:
    MousePointer = vbDefault
    MsgBox "请选择要修改的记录！", vbExclamation, "错误提示"
End Sub

Private Sub Cmdexit_Click()
Unload Me
End Sub

Private Sub Cmdprint_Click()
'发生错误
On Error GoTo errprint
MousePointer = vbHourglass
Report1.DataFiles(0) = App.Path & "\yhsg.mdb"
Report1.ReportFileName = App.Path & "\rpt\shdj.rpt"
Report1.Formulas(0) = "tjrq='" & tjrq & "'"
MousePointer = vbDefault
Dim Msg As Integer
Msg = MsgBox("要预览吗？", vbYesNoCancel)
If Msg = vbYes Or Msg = vbNo Then
   If Msg = vbNo Then
      Report1.Destination = crptToPrinter
    Else
      Report1.Destination = crptToWindow
   End If
   Report1.Action = 1
End If
Exit Sub

errprint:
    MousePointer = vbDefault
    If err.Number = 20513 Then
       MsgBox "打印机未准备好", vbOKOnly + vbCritical, "警告"
    Else
    errnb = err.Number
    errds = err.Description
    MsgBox errnb & errds, vbOKOnly
    End If
End Sub

Private Sub Cmdsm_Change()
Call juming
End Sub

Private Sub Cmdsm_Click()
Call juming
End Sub

Private Sub Cmdsm2_Change()
Call juming2
End Sub

Private Sub Cmdsm2_Click()
Call juming2
End Sub

Private Sub Cmdsm3_Change()
Call juming3
End Sub

Private Sub Cmdsm3_Click()
Call juming3
End Sub

Private Sub Cmdupdate_Click()
On Error GoTo err

If MsgBox("确认要修改吗？", vbQuestion + vbYesNo, "询问") = vbYes Then
   MousePointer = vbHourglass
     '检查数据完成性
    If Cmdsm3.Text = "" Then
       MsgBox "用户省名不能为空！", vbInformation, "信息"
       Cmdsm3.SetFocus
       Exit Sub
    Else
       sm = Trim(Cmdsm3.Text)
    End If
    If Cmdjm3.Text = "" Then
       MsgBox "用户局名不能为空！", vbInformation, "信息"
       Cmdjm3.SetFocus
       Exit Sub
    Else
       jm = Trim(Cmdjm3.Text)
    End If
    If Cmdbjmc3.Text = "" Then
       MsgBox "备件名称不能为空！", vbInformation, "信息"
       Cmdbjmc3.SetFocus
       Exit Sub
    Else
       bjmc = Trim(Cmdbjmc3.Text)
       Dim rsbjmc As Recordset
       Set rsbjmc = db.OpenRecordset("select bjmc from bjmc where bjmc='" & bjmc & "'")
       If rsbjmc.RecordCount = 0 Then
          rsbjmc.AddNew
          rsbjmc.Fields!bjmc = bjmc
          rsbjmc.Update
          Cmdbjmc3.AddItem bjmc
          Cmdbjmc.AddItem bjmc
       End If
       rsbjmc.Close
    End If
    If Txtsl3.Text = "" Then
       MsgBox "收货数量不能为空！", vbInformation, "信息"
       Txtsl3.SetFocus
       Exit Sub
    Else
       sl = CLng(Trim(Txtsl3.Text))
    End If
    shxx = Trim(Txtshxx3.Text)
    shsj = CStr(Format(DTPick4.Value, "yyyy-mm-dd"))
    
    MousePointer = vbHourglass
    '检查局方信息
    Dim jfxxbj As Boolean
    jfxxbj = False
    Dim rs1 As Recordset
    Set rs1 = db.OpenRecordset("select * from jfxx")
    If rs1.RecordCount > 0 Then
       Do While Not rs1.EOF
          If rs1.Fields!sm = sm And rs1.Fields!jm = jm Then
             jfxxid = rs1.Fields!id
             jfxxbj = True
             Exit Do
          End If
          rs1.MoveNext
       Loop
    End If
    If jfxxbj = False Then
       rs1.MoveLast
       rs1.AddNew
       rs1.Fields!sm = sm
       rs1.Fields!jm = jm
       rs1.Update
       rs1.MoveLast
       jfxxid = rs1.Fields!id
    End If
    rs1.Close
    Set rs1 = db.OpenRecordset("select * from shdj where jfxxid=" & _
                               jfxxid & " and bjmc='" & bjmc & _
                               "' and sl=" & sl & " and shsj='" & shsj & "' and shxx='" & shxx & "'")
    If rs1.RecordCount > 0 Then
       MousePointer = vbDefault
       MsgBox "收货记录重复！", vbExclamation, "信息"
       Exit Sub
    Else
       Dim rs2 As Recordset
       Set rs2 = db.OpenRecordset("select * from shdj where id=" & _
                               Data1.Recordset.Fields!id)
       rs2.Edit
       rs2.Fields!jfxxid = jfxxid
       rs2.Fields!bjmc = bjmc
       rs2.Fields!sl = sl
       rs2.Fields!shxx = shxx
       rs2.Fields!shsj = shsj
       rs2.Update
       rs2.Close
       Data1.Recordset.Edit
       Data1.Recordset.Fields!jfxxid = jfxxid
       Data1.Recordset.Fields!sm = sm
       Data1.Recordset.Fields!jm = jm
       Data1.Recordset.Fields!bjmc = bjmc
       Data1.Recordset.Fields!sl = sl
       Data1.Recordset.Fields!shxx = shxx
       Data1.Recordset.Fields!shsj = shsj
       Data1.Recordset.Update
       'Data1.Refresh
    End If
    rs1.Close
    MousePointer = vbDefault
    Cmdprint.Enabled = True
    Cmdupdate.Enabled = True
    Cmddel.Enabled = True
    bh = True
'    Cmdsm3.Text = ""
'    Cmdjm3.Text = ""
'    Cmdbjmc3.Text = ""
'    Txtshxx3.Text = ""
'    DTPick4.Value = Date
'    Txtsl3.Text = ""
End If
Exit Sub

err:
    MousePointer = vbDefault
    MsgBox err.Description, vbExclamation, "错误提示"
End Sub

Private Sub DBGrid_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
On Error GoTo err
If bh = True Then
   With Data1.Recordset
   Cmdsm3.Text = .Fields!sm
   Cmdjm3.Text = .Fields!jm
   Cmdbjmc3.Text = .Fields!bjmc
   Txtshxx3.Text = .Fields!shxx
   DTPick4.Value = .Fields!shsj
   Txtsl3.Text = .Fields!sl
   End With
End If
Exit Sub

err:
   Cmdsm3.Text = ""
   Cmdjm3.Text = ""
   Cmdbjmc3.Text = ""
   Txtshxx3.Text = ""
   DTPick4.Value = Date
   Txtsl3.Text = ""
End Sub

Private Sub Form_Load()
MDIFrm.Caption = MDIFrm.Caption & "---[收货登记查询]"
MDIFrm.numshdjcx.Enabled = False
Me.Top = 200
Me.Left = 1800
Me.Height = 6495
Me.Width = 8175
Dim rsbjmc As Recordset
Set rsbjmc = db.OpenRecordset("select * from bjmc")
If rsbjmc.RecordCount > 0 Then
   Do While Not rsbjmc.EOF
      Cmdbjmc.AddItem rsbjmc.Fields!bjmc
      Cmdbjmc2.AddItem rsbjmc.Fields!bjmc
      Cmdbjmc3.AddItem rsbjmc.Fields!bjmc
      rsbjmc.MoveNext
   Loop
End If
rsbjmc.Close
DTPick1.Value = Date
DTPick2.Value = Date
DTPick3.Value = Date
DTPick4.Value = Date
Call shengming

db.Execute "delete from temp_shdj"
Set rsls = db.OpenRecordset("select sm,jm,bjmc,sl,shxx,shsj,id,jfxxid from temp_shdj")
Set Data1.Recordset = rsls
Data1.Refresh
Call biaotou
Cmdprint.Enabled = False
Cmdupdate.Enabled = False
Cmddel.Enabled = False
SSTab1.Tab = 0
bh = False
tjrq = ""
End Sub

Private Sub Form_Unload(Cancel As Integer)
MDIFrm.numshdjcx.Enabled = True
rsls.Close
MDIFrm.Caption = App.Title
End Sub

Private Sub biaotou()
DBGrid.Columns(0).Caption = "省名"
DBGrid.Columns(0).Width = 800
DBGrid.Columns(0).Alignment = dbgCenter
DBGrid.Columns(1).Caption = "局名"
DBGrid.Columns(1).Width = 2300
DBGrid.Columns(1).Alignment = dbgCenter
DBGrid.Columns(2).Caption = "备件名称"
DBGrid.Columns(2).Width = 1200
'DBGrid.Columns(2).Alignment = dbgCenter
DBGrid.Columns(3).Caption = "数量 "
DBGrid.Columns(3).Width = 800
DBGrid.Columns(3).Alignment = dbgCenter
DBGrid.Columns(4).Caption = "收货信息"
DBGrid.Columns(4).Width = 1500
'DBGrid.Columns(4).Alignment = dbgCenter
DBGrid.Columns(5).Caption = "收货日期"
DBGrid.Columns(5).Width = 1000
DBGrid.Columns(5).Alignment = dbgCenter
DBGrid.Columns(6).Caption = "id"
DBGrid.Columns(6).Width = 1000
DBGrid.Columns(6).Alignment = dbgCenter
DBGrid.Columns(7).Caption = "局方信息id"
DBGrid.Columns(7).Width = 1000
End Sub

Private Sub shengming()
Dim rs1 As Recordset
Set rs1 = db.OpenRecordset("select distinct sm from jfxx")
If rs1.RecordCount > 0 Then
   Do While Not rs1.EOF
      Cmdsm.AddItem rs1.Fields!sm
      Cmdsm2.AddItem rs1.Fields!sm
      Cmdsm3.AddItem rs1.Fields!sm
      rs1.MoveNext
   Loop
End If
rs1.Close
End Sub
Private Sub juming3()
Dim rsjm As Recordset
Set rsjm = db.OpenRecordset("select distinct jm from jfxx where sm='" & Trim(Cmdsm3.Text) & "'")
Cmdjm3.Clear
If rsjm.RecordCount > 0 Then
   Do While Not rsjm.EOF
      Cmdjm3.AddItem rsjm.Fields!jm
      rsjm.MoveNext
   Loop
End If
rsjm.Close
Cmdjm3.Text = Cmdjm3.List(0)
End Sub

Private Sub juming()
Dim rsjm As Recordset
Set rsjm = db.OpenRecordset("select distinct jm from jfxx where sm='" & Trim(Cmdsm.Text) & "'")
Cmdjm.Clear
If rsjm.RecordCount > 0 Then
   Do While Not rsjm.EOF
      Cmdjm.AddItem rsjm.Fields!jm
      rsjm.MoveNext
   Loop
End If
rsjm.Close
Cmdjm.Text = Cmdjm.List(0)
End Sub

Public Sub juming2()
Dim rsjm As Recordset
Set rsjm = db.OpenRecordset("select distinct jm from jfxx where sm='" & Trim(Cmdsm2.Text) & "'")
Cmdjm2.Clear
If rsjm.RecordCount > 0 Then
   Do While Not rsjm.EOF
      Cmdjm2.AddItem rsjm.Fields!jm
      rsjm.MoveNext
   Loop
End If
rsjm.Close
Cmdjm2.Text = Cmdjm2.List(0)
End Sub