frmstockcondtion.frm

针对农资系统的管理模式而开发的业务部门与财务部门的转账模式和过程

VERSION 5.00
Begin VB.Form frmStockCondtion 
   Caption         =   "查询条件设置"
   ClientHeight    =   2640
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   3825
   LinkTopic       =   "Form1"
   ScaleHeight     =   2640
   ScaleWidth      =   3825
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton cmdNext 
      Caption         =   "查 帐"
      Height          =   375
      Left            =   2280
      TabIndex        =   6
      Top             =   2160
      Width           =   1095
   End
   Begin VB.ComboBox cobHouse 
      Height          =   300
      Left            =   960
      Style           =   2  'Dropdown List
      TabIndex        =   3
      Top             =   240
      Width           =   2535
   End
   Begin VB.ComboBox cobwares 
      Height          =   300
      Left            =   960
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   720
      Width           =   2535
   End
   Begin VB.ComboBox cobMonthStart 
      Height          =   300
      Left            =   240
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   1560
      Width           =   1455
   End
   Begin VB.ComboBox cobMonthEnd 
      Height          =   300
      Left            =   1920
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   1560
      Width           =   1575
   End
   Begin VB.Label Label2 
      Caption         =   "日期范围"
      Height          =   255
      Left            =   240
      TabIndex        =   7
      Top             =   1200
      Width           =   1215
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "库　房"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   180
      Left            =   240
      TabIndex        =   5
      Top             =   240
      Width           =   600
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "商  品"
      Height          =   180
      Left            =   240
      TabIndex        =   4
      Top             =   720
      Width           =   540
   End
End
Attribute VB_Name = "frmStockCondtion"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim m_sHouseCode As String
Dim m_sWaresCode As String


Private Sub cmdNext_Click()
'先检查
Dim DateStart As Date
Dim DateEnd As Date

Dim sHouseName As String

Dim sWaresName As String
Dim sTemp As String
sTemp = cobMonthEnd.List(cobMonthEnd.ListIndex)
DateStart = cobMonthStart.List(cobMonthStart.ListIndex) & "01日"
Dim i As Integer
For i = 31 To 28 Step -1
    
    If IsDate(sTemp & i & "日") Then
        DateEnd = sTemp & i & "日"
        Exit For
    End If
Next i
If DateStart > DateEnd Then
    MsgBox "日期范围选择有误!,请重新选择!"
    Exit Sub
End If
sHouseName = cobHouse.List(cobHouse.ListIndex)
sHouseName = Mid(sHouseName, InStr(sHouseName, " "))


sWaresName = cobwares.List(cobwares.ListIndex)
sWaresName = Mid(sWaresName, InStr(sWaresName, " "))


Let frmStock.params(m_sHouseCode, sHouseName, m_sWaresCode, sWaresName, DateStart) = DateEnd

Unload Me
frmStock.Show
End Sub
Private Sub cobHouse_click()
 m_sHouseCode = cobHouse.List(cobHouse.ListIndex)
 m_sHouseCode = Left(m_sHouseCode, InStr(m_sHouseCode, " ") - 1)

End Sub

Private Sub cobwares_click()
m_sWaresCode = cobwares.List(cobwares.ListIndex)
 m_sWaresCode = Left(m_sWaresCode, InStr(m_sWaresCode, " ") - 1)

End Sub

Private Sub Form_Load()
FillCobMonth
FillHouse
cobHouse_click
Fillwares m_sHouseCode
cobwares_click
End Sub
Private Sub FillCobMonth()
Dim rs As ADODB.Recordset
Dim StartYear As Integer
Dim StartMonth As Integer
Dim EndYear As Integer
Dim EndMonth As Integer
Set rs = New ADODB.Recordset
rs.Open "select Fyear, FMonth from ledger order by FYear,FMonth", m_gDBCnn, adOpenStatic, adLockReadOnly
If rs.EOF And rs.BOF Then
    MsgBox "没有帐可查?"
    cmdNext.Enabled = False
    Exit Sub
Else
    Do While Not rs.EOF
        StartYear = rs!FYear
        StartMonth = rs!FMonth
        rs.MoveLast
        EndYear = rs!FYear
        EndMonth = rs!FMonth
        rs.MoveNext
    Loop
    rs.Close
End If
Dim nMonthSum As Integer
nMonthSum = (EndYear - StartYear) * 12 + EndMonth - StartMonth + 1
Dim i As Integer
StartMonth = StartMonth - 1
For i = 1 To nMonthSum
    StartMonth = StartMonth + 1
    If StartMonth = 13 Then
        StartMonth = 1
        StartYear = StartYear + 1
    End If
        cobMonthStart.AddItem StartYear & "年" & StartMonth & "月"
        cobMonthEnd.AddItem StartYear & "年" & StartMonth & "月"
Next i
Me.cobMonthEnd.ListIndex = 0
Me.cobMonthStart.ListIndex = 0
End Sub
Private Sub FillHouse()
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim sql As String
sql = "SELECT DISTINCT Ledger.FHouseCode, Warehouse.FHouseName " & _
 "FROM Ledger INNER JOIN Warehouse ON Ledger.FHouseCode = Warehouse.FHouseCode " & _
 "order by Ledger.FHouseCode"
rs.Open sql, m_gDBCnn, adOpenStatic, adLockReadOnly
Do While Not rs.EOF
Me.cobHouse.AddItem rs!Fhousecode & " " & rs!FHouseName
rs.MoveNext
Loop
rs.Close
If Me.cobHouse.ListCount >= 1 Then Me.cobHouse.ListIndex = 0
End Sub
Private Sub Fillwares(sHouseCode As String)
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim sql As String
sql = "SELECT DISTINCT Ledger.FWaresCode,WaresList.FName " & _
"FROM Ledger INNER JOIN WaresList ON Ledger.FWaresCode = WaresList.FWaresCode " & _
" Where Ledger.FHouseCode = '" & sHouseCode & "'"

rs.Open sql, m_gDBCnn, adOpenStatic, adLockReadOnly
Do While Not rs.EOF
Me.cobwares.AddItem rs!FWaresCode & " " & rs!FName
rs.MoveNext
Loop
rs.Close
If Me.cobwares.ListCount >= 1 Then Me.cobwares.ListIndex = 0
End Sub