收发货统计.frm

部门在用的用户申告系统

        End If
    Else
       If Comboyhjm.Text <> "" Then
          jm = Trim(Comboyhjm.Text)
          strsql = " and jm='" & jm & "'"
        Else
          MousePointer = vbDefault
          MsgBox "统计条件局名不能为空", vbInformation, "信息"
          Exit Sub
        End If
    End If
End If
strsql2 = strsql
If Chktjsj.Value = 1 Then
   If strsql <> "" Then
      strsql = strsql & " and shsj>='" & tjsj1 & "' and shsj<='" & tjsj2 & "'"
   Else
      strsql = " and shsj>='" & tjsj1 & "' and shsj<='" & tjsj2 & "'"
   End If
   If strsq2 <> "" Then
      strsql2 = strsql2 & " and fhsj>='" & tjsj1 & "' and fhsj<='" & tjsj2 & "'"""
   Else
      strsql2 = " and fhsj>='" & tjsj1 & "' and fhsj<='" & tjsj2 & "'"
   End If
   tjrq = "统计时间： " & tjsj1 & " 至 " & tjsj2
   
End If

Dim rs As Recordset
Dim strml As String
strml = "select sum(shdj.sl) as shsl,sum(fhdj.sl) as fhsl from jfxx,shdj,fhdj where " & _
       "jfxx.id=shdj.jfxxid=fhdj.jfxxid" & strsql
Dim rssm As Recordset
Dim rsjm As Recordset
Dim rssh As Recordset
Dim rsfh As Recordset
Dim rsbjmc As Recordset
Dim smbj As Boolean
Dim jmbj As Boolean
Dim bjmcbj As Boolean
smbj = False
jmbj = False
bjmcbj = False
Set rssm = db.OpenRecordset("select sm from jfxx")
Set rsbjmc = db.OpenRecordset("select bjmc from bjmc")
Dim s1, s2, s3 As Long 'S1省名记数S2局名记数S3备件名称记数
Dim jinru As Boolean '进入进度条设置标志
jinru = True
rssm.MoveLast
rssm.MoveFirst
Do While Not rssm.EOF
   If smbj = True Then
      Exit Do
    Else
      If Chkyhsm.Value = 1 Then
         sm = Trim(Comboyhsm.Text)
         smbj = True
         If jinru = True Then s1 = 1
        Else
         sm = rssm.Fields!sm
        If jinru = True Then s1 = rssm.RecordCount
      End If
   End If
   Set rsjm = db.OpenRecordset("select jm from jfxx where sm='" & sm & "'")
   If rsjm.RecordCount > 0 Then
      rsjm.MoveLast
      rsjm.MoveFirst
      Do While Not rsjm.EOF
         If jmbj = True Then
            Exit Do
          Else
            If Chkyhjm.Value = 1 Then
               jm = Trim(Comboyhjm.Text)
               jmbj = True
               If jinru = True Then s2 = 1
             Else
               jm = rsjm.Fields!jm
               If jinru = True Then s2 = rsjm.RecordCount
            End If
         End If
         If rsbjmc.RecordCount > 0 Then
            rsbjmc.MoveLast
            rsbjmc.MoveFirst
         End If
         Do While Not rsbjmc.EOF
            If bjmcbj = True Then
               bjmcbj = False
               Exit Do
             Else
               If Chkbjmc.Value = 1 Then
                  bjmcbj = True
                  bjmc = Trim(Combobjmc.Text)
                  If jinru = True Then s3 = 1
                Else
                  bjmc = rsbjmc.Fields!bjmc
                  If jinru = True Then s3 = rsbjmc.RecordCount
               End If
            End If
            If jinru = True Then
               DBGrid.Height = 4215
               DBGrid.Top = 1680
               Bar.Visible = True
               Bar.Min = 0
               Bar.Max = s1 * s2 * s3
               Bar.Value = 0
            End If
            jinru = False
            Set rssh = db.OpenRecordset("select sum(sl) as shsl from jfxx,shdj where jfxx.id=shdj.jfxxid and bjmc='" & bjmc & "' and jm='" & jm & "'" & strsql)
            If Not IsNull(rssh.Fields!shsl) Then
               shsl = rssh.Fields!shsl
             Else
               shsl = 0
            End If
            rssh.Close
            Set rsfh = db.OpenRecordset("select sum(sl) as fhsl from jfxx,fhdj where jfxx.id=fhdj.jfxxid and bjmc='" & bjmc & "' and jm='" & jm & "'" & strsql2)
            If Not IsNull(rsfh.Fields!fhsl) Then
               fhsl = rsfh.Fields!fhsl
             Else
               fhsl = 0
            End If
            rsfh.Close
            If shsl > 0 Or fhsl > 0 Then
               If rsls.RecordCount > 0 Then
                  rsls.MoveLast
               End If
               rsls.AddNew
               rsls.Fields!jm = jm
               rsls.Fields!bjmc = bjmc
               rsls.Fields!shsl = shsl
               rsls.Fields!fhsl = fhsl
               rsls.Fields!sysl = shsl - fhsl
               rsls.Update
            End If
            DoEvents
            If Bar.Value < Bar.Max Then Bar.Value = Bar.Value + 1
            rsbjmc.MoveNext
         Loop
         DoEvents
         rsjm.MoveNext
      Loop
   End If
   rsjm.Close
   DoEvents
  rssm.MoveNext
Loop
rssm.Close
rsbjmc.Close
Bar.Visible = False
DBGrid.Height = 4455
DBGrid.Top = 1440
Data1.Refresh
Call biaotou
If Data1.Recordset.RecordCount > 0 Then
   Cmdprint.Enabled = True
Else
   Cmdprint.Enabled = False
End If

MousePointer = vbDefault '设置鼠标状态

End Sub

Private Sub Comboyhsm_Change()
Dim Rsyhjm As Recordset
Comboyhjm.Clear
'根据用户省名查询用户局名
sm = Trim(Comboyhsm.Text)
If sm <> "" Then
   Set Rsyhjm = db.OpenRecordset("select jm from jfxx where sm='" & sm & "'")
   If Rsyhjm.RecordCount > 0 Then
      Do While Not Rsyhjm.EOF
         Comboyhjm.AddItem Rsyhjm.Fields!jm
         Rsyhjm.MoveNext
      Loop
   End If
   Rsyhjm.Close
End If
End Sub

Private Sub Comboyhsm_Click()
Dim Rsyhjm As Recordset
Comboyhjm.Clear
'根据用户省名查询用户局名
sm = Trim(Comboyhsm.Text)
If sm <> "" Then
   Set Rsyhjm = db.OpenRecordset("select jm from jfxx where sm='" & sm & "'")
   If Rsyhjm.RecordCount > 0 Then
      Do While Not Rsyhjm.EOF
         Comboyhjm.AddItem Rsyhjm.Fields!jm
         Rsyhjm.MoveNext
      Loop
   End If
   Rsyhjm.Close
End If
End Sub

Private Sub Form_Load()
MDIFrm.Caption = MDIFrm.Caption & "---[收发货统计]"
Me.Top = 200
Me.Left = 1500
Me.Height = 6330
Me.Width = 8055
Bar.Visible = False
DBGrid.Height = 4455
DBGrid.Top = 1440
'设置按钮状态
MDIFrm.numsftj.Enabled = False
Cmdprint.Enabled = False
'设置COMBO用户省名，
Dim rsyhsm As Recordset
Set rsyhsm = db.OpenRecordset("select distinct sm from jfxx")
If rsyhsm.RecordCount > 0 Then
    rsyhsm.MoveFirst
    Do While Not rsyhsm.EOF
       Comboyhsm.AddItem rsyhsm.Fields!sm
       rsyhsm.MoveNext
    Loop
End If
rsyhsm.Close
Dim rsbjmc As Recordset
Set rsbjmc = db.OpenRecordset("select distinct bjmc from bjmc")
If rsbjmc.RecordCount > 0 Then
   Do While Not rsbjmc.EOF
      Combobjmc.AddItem rsbjmc.Fields!bjmc
      rsbjmc.MoveNext
   Loop
End If
rsbjmc.Close

'设置日期显示
DTPiktjsj1.Value = Date
DTPiktjsj2.Value = Date
'设置Dbgrid不能更新
'DBGrid.AllowUpdate = False
db.Execute "delete from temp_sftj"
Set rsls = db.OpenRecordset("select * from temp_sftj")
Set Data1.Recordset = rsls
Data1.Refresh
Call biaotou
End Sub

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

Private Sub biaotou()
DBGrid.Columns(0).Caption = "局名"
DBGrid.Columns(0).Width = 2500
DBGrid.Columns(0).Alignment = dbgCenter
DBGrid.Columns(1).Caption = "备件名称"
DBGrid.Columns(1).Width = 2000
DBGrid.Columns(1).Alignment = dbgCenter
DBGrid.Columns(2).Caption = "收货数量"
DBGrid.Columns(2).Width = 950
DBGrid.Columns(2).Alignment = dbgCenter
DBGrid.Columns(3).Caption = "发货数量"
DBGrid.Columns(3).Width = 950
DBGrid.Columns(3).Alignment = dbgCenter
DBGrid.Columns(4).Caption = "剩余数量"
DBGrid.Columns(4).Width = 950
DBGrid.Columns(4).Alignment = dbgCenter
End Sub