按备件名称统计.frm

部门在用的用户申告系统

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{00028C01-0000-0000-0000-000000000046}#1.0#0"; "DBGRID32.OCX"
Object = "{00025600-0000-0000-C000-000000000046}#4.6#0"; "crystl32.ocx"
Begin VB.Form Frmbjmctj 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "按备件名称统计"
   ClientHeight    =   6090
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6150
   Icon            =   "按备件名称统计.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   ScaleHeight     =   6090
   ScaleWidth      =   6150
   Begin Crystal.CrystalReport Report1 
      Left            =   2280
      Top             =   2640
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   262150
   End
   Begin MSDBGrid.DBGrid DBGrid 
      Bindings        =   "按备件名称统计.frx":014A
      Height          =   4695
      Left            =   0
      OleObjectBlob   =   "按备件名称统计.frx":015E
      TabIndex        =   9
      Top             =   1320
      Width           =   6135
   End
   Begin VB.Data Data1 
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   ""
      DefaultCursorType=   0  '缺省游标
      DefaultType     =   2  '使用 ODBC
      Exclusive       =   0   'False
      Height          =   285
      Left            =   2160
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   ""
      Top             =   480
      Visible         =   0   'False
      Width           =   1140
   End
   Begin VB.Frame Frame1 
      Caption         =   "统计条件"
      Height          =   1215
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   6135
      Begin VB.CommandButton Cmdexit 
         Caption         =   "退出"
         Height          =   375
         Left            =   4680
         TabIndex        =   8
         Top             =   720
         Width           =   1335
      End
      Begin VB.CommandButton Cmdprint 
         Caption         =   "打印"
         Height          =   375
         Left            =   5400
         TabIndex        =   7
         Top             =   240
         Width           =   615
      End
      Begin VB.CommandButton Cmdtj 
         Caption         =   "统计"
         Height          =   375
         Left            =   4680
         TabIndex        =   6
         Top             =   240
         Width           =   615
      End
      Begin MSComCtl2.DTPicker DTPick2 
         Height          =   255
         Left            =   2880
         TabIndex        =   5
         Top             =   720
         Width           =   1575
         _ExtentX        =   2778
         _ExtentY        =   450
         _Version        =   393216
         CalendarForeColor=   16744576
         Format          =   62717953
         CurrentDate     =   38411
      End
      Begin MSComCtl2.DTPicker DTPick1 
         Height          =   255
         Left            =   1200
         TabIndex        =   4
         Top             =   720
         Width           =   1335
         _ExtentX        =   2355
         _ExtentY        =   450
         _Version        =   393216
         CalendarForeColor=   16744576
         Format          =   62717953
         CurrentDate     =   38411
      End
      Begin VB.ComboBox Combobjmc 
         Height          =   300
         Left            =   1200
         Style           =   2  'Dropdown List
         TabIndex        =   3
         Top             =   240
         Width           =   3255
      End
      Begin VB.CheckBox Chktjsj 
         Caption         =   "统计时间"
         Height          =   255
         Left            =   120
         TabIndex        =   2
         Top             =   720
         Width           =   1095
      End
      Begin VB.CheckBox Chkbjmc 
         Caption         =   "备件名称"
         Height          =   255
         Left            =   120
         TabIndex        =   1
         Top             =   240
         Width           =   1095
      End
   End
End
Attribute VB_Name = "Frmbjmctj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rs As Recordset
Dim rsbjmc As Recordset
Dim tjrq As String
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\sftj2.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
    Dim errnb As Long
    errnb = err.Number
    Dim errds As String
    errds = err.Description
    MsgBox errnb & errds, vbOKOnly
    End If
End Sub

Private Sub Cmdtj_Click()
Dim bjmc As String
Dim strsql As String
Dim strsql2 As String
Dim tjsj1 As String
Dim tjsj2 As String
If Chkbjmc.Value = 1 Then
   If Combobjmc.Text = "" Then
      MsgBox "统计条件备件名称不能为空！", vbInformation, "信息"
      Combobjmc.SetFocus
      Exit Sub
   End If
End If
tjsj1 = Format(DTPick1.Value, "yyyy-mm-dd")
tjsj2 = Format(DTPick2.Value, "yyyy-mm-dd")
If Chktjsj.Value = 1 Then
   tjrq = "统计日期： " & tjsj1 & " 至 " & tjsj2
   strsql = " and shsj>='" & tjsj1 & "' and shsj<='" & tjsj2 & "'"
   strsql2 = " and fhsj>='" & tjsj1 & "' and fhsj<='" & tjsj2 & "'"
Else
   tjrq = ""
End If
MousePointer = vbHourglass
db.Execute "delete from temp_sftj2"
rsbjmc.MoveFirst
Dim bjmcbj As Boolean
bjmcbj = False
Dim shsl As Long
Dim fhsl As Long
shsl = 0
fhsl = 0
Dim rssh As Recordset
Dim rsfh As Recordset
If rsbjmc.RecordCount > 0 Then
   Do While Not rsbjmc.EOF
      If bjmcbj = True Then
         Exit Do
      End If
      If Chkbjmc.Value = 1 Then
         bjmcbj = True
         bjmc = Trim(Combobjmc.Text)
        Else
         bjmc = rsbjmc.Fields!bjmc
      End If
      Set rssh = db.OpenRecordset("select sum(sl) as shsl from shdj where bjmc='" & bjmc & "'" & 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 fhdj where bjmc='" & bjmc & "'" & 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 rs.RecordCount > 0 Then
            rs.MoveLast
         End If
         rs.AddNew
         rs.Fields!bjmc = bjmc
         rs.Fields!shsl = shsl
         rs.Fields!fhsl = fhsl
         rs.Fields!sysl = shsl - fhsl
         rs.Update
      End If
      DoEvents
      rsbjmc.MoveNext
   Loop
End If
Data1.Refresh
If Data1.Recordset.RecordCount > 0 Then
   Cmdprint.Enabled = True
Else
   Cmdprint.Enabled = False
End If
Call biaotou
MousePointer = vbDefault
End Sub

Private Sub Form_Load()
tjrq = ""
MDIFrm.numbjmctj.Enabled = False
MDIFrm.Caption = MDIFrm.Caption & "---[按备件名称统计]"
db.Execute "delete from temp_sftj2"
Me.Top = 200
Me.Left = 2900
Me.Height = 6465
Me.Width = 6240
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

Set rs = db.OpenRecordset("select * from temp_sftj2")
Set Data1.Recordset = rs
Data1.Refresh
Cmdprint.Enabled = False
DTPick1.Value = Date
DTPick2.Value = Date
Call biaotou
End Sub

Private Sub Form_Unload(Cancel As Integer)
rsbjmc.Close
rs.Close
MDIFrm.numbjmctj.Enabled = True
MDIFrm.Caption = App.Title
End Sub

Private Sub biaotou()
DBGrid.Columns(0).Caption = "备件名称"
DBGrid.Columns(0).Width = 2100
DBGrid.Columns(0).Alignment = dbgCenter
DBGrid.Columns(1).Caption = "收货数量"
DBGrid.Columns(1).Width = 1200
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 = 1200
DBGrid.Columns(3).Alignment = dbgCenter
End Sub