导出查询界面.frm

财务信息管理系统,适合做毕业论文的人使用

VERSION 5.00
Begin VB.Form frmExportQuery 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "导出条件选择"
   ClientHeight    =   4815
   ClientLeft      =   2880
   ClientTop       =   1080
   ClientWidth     =   6195
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4815
   ScaleWidth      =   6195
   Begin VB.CommandButton cmdRef2 
      Height          =   255
      Left            =   5520
      TabIndex        =   9
      Top             =   2400
      Width           =   255
   End
   Begin VB.CommandButton cmdRef1 
      Height          =   255
      Left            =   3360
      TabIndex        =   7
      Top             =   2400
      Width           =   255
   End
   Begin VB.CommandButton cmdQuit 
      Cancel          =   -1  'True
      Caption         =   "退出"
      Height          =   375
      Left            =   3720
      TabIndex        =   13
      Top             =   4320
      Width           =   1095
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   375
      Left            =   1440
      TabIndex        =   12
      Top             =   4320
      Width           =   1095
   End
   Begin VB.ComboBox cboCheck 
      Height          =   300
      Left            =   2040
      TabIndex        =   11
      Top             =   3720
      Width           =   2295
   End
   Begin VB.ComboBox cboUnitName 
      Height          =   300
      Left            =   2040
      TabIndex        =   5
      Top             =   1680
      Width           =   2295
   End
   Begin VB.ComboBox cboBill 
      Height          =   300
      Left            =   2040
      TabIndex        =   10
      Top             =   3120
      Width           =   2295
   End
   Begin VB.TextBox txtEndDate 
      Height          =   270
      Left            =   4200
      TabIndex        =   8
      Top             =   2392
      Width           =   1575
   End
   Begin VB.TextBox txtStartDate 
      Height          =   270
      Left            =   2040
      TabIndex        =   6
      Top             =   2392
      Width           =   1575
   End
   Begin VB.TextBox txtEndID 
      Height          =   270
      Left            =   4200
      MaxLength       =   20
      TabIndex        =   4
      Top             =   1065
      Width           =   1575
   End
   Begin VB.ComboBox cboVchStyle 
      Height          =   300
      Left            =   2040
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   240
      Width           =   2295
   End
   Begin VB.TextBox txtStartID 
      Height          =   270
      Left            =   2040
      MaxLength       =   20
      TabIndex        =   2
      Top             =   1065
      Width           =   1575
   End
   Begin VB.Label Label8 
      Alignment       =   2  'Center
      Caption         =   "至"
      Height          =   255
      Left            =   3720
      TabIndex        =   19
      Top             =   2400
      Width           =   375
   End
   Begin VB.Label Label6 
      Alignment       =   1  'Right Justify
      Caption         =   "审 核 人："
      Height          =   255
      Left            =   240
      TabIndex        =   18
      Top             =   3743
      Width           =   1335
   End
   Begin VB.Label Label5 
      Alignment       =   1  'Right Justify
      Caption         =   "制 单 人："
      Height          =   255
      Left            =   240
      TabIndex        =   17
      Top             =   3143
      Width           =   1335
   End
   Begin VB.Label Label4 
      Alignment       =   1  'Right Justify
      Caption         =   "日    期："
      Height          =   255
      Left            =   240
      TabIndex        =   16
      Top             =   2400
      Width           =   1335
   End
   Begin VB.Label Label3 
      Alignment       =   1  'Right Justify
      Caption         =   "单位名称："
      Height          =   255
      Left            =   240
      TabIndex        =   15
      Top             =   1703
      Width           =   1335
   End
   Begin VB.Label Label7 
      Alignment       =   2  'Center
      Caption         =   "至"
      Height          =   255
      Left            =   3720
      TabIndex        =   14
      Top             =   1080
      Width           =   375
   End
   Begin VB.Label Label2 
      Alignment       =   1  'Right Justify
      Caption         =   "单据编号："
      Height          =   255
      Left            =   240
      TabIndex        =   3
      Top             =   1080
      Width           =   1335
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      Caption         =   "单据类型："
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   263
      Width           =   1335
   End
End
Attribute VB_Name = "frmExportQuery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'and t1.istate<>'1' and t1.bdestroy<>'1' and t2.istate<>'1' and t2.bdestroy<>'1'
Option Explicit
Dim unitID As New Collection

Private Sub cmdOK_Click()
    '校验字段
    If bCheckField Then
        Dim sql As String
        Dim rs As New adodb.Recordset
        
    sql = " from fd_Transactions left join fd_accdef as t1 on fd_Transactions.rcv_acc_id=t1.accdef_id " & _
            "left join fd_accdef as t2 on fd_Transactions.pay_acc_id=t2.accdef_id " & _
            "left join fd_accunit as t3 on t1.accunit_id=t3.accunit_id " & _
            "left join fd_accunit as t4 on t2.accunit_id=t4.accunit_id " & GetQuery
            
        frmExportList.SetSql sql
        Hide
    Else
        Exit Sub
    End If
    ClearInfo
End Sub

Private Sub ClearInfo()
    If cboVchStyle.ListCount <> 0 Then
        cboVchStyle.ListIndex = 0
    End If
    txtStartID.Text = ""
    txtEndID.Text = ""
    cboUnitName.Text = ""
    txtStartDate.Text = ""
    txtEndDate.Text = ""
    cboBill.Text = ""
    cboCheck.Text = ""
End Sub
    
Private Sub cmdQuit_Click()
    Unload Me
End Sub

Private Sub cmdRef1_Click()
    DisplayCalendar Me.txtStartDate, Me.hWnd, 0 - txtStartDate.Width, 0 - txtStartDate.Height
End Sub

Private Sub cmdRef2_Click()
    DisplayCalendar txtEndDate, Me.hWnd, 0 - txtEndDate.Width, 0 - txtEndDate.Height
End Sub

Private Sub Form_Load()
    FillUser
    FillVchStyle
    FillUnitName
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set unitID = Nothing
End Sub

Private Sub txtStartDate_LostFocus()
    Dim tmp As String
    
    If Me.ActiveControl.Name = "cmdRef1" Then
        Exit Sub
    End If
    
    tmp = txtStartDate.Text
    If tmp = "" Then
    
    ElseIf tmp <> "" And bCheckDate(tmp) Then
        txtStartDate.Text = tmp
    Else
        txtStartDate.SelStart = 0
        txtStartDate.SelLength = Len(txtStartDate.Text)
        MsgBox "日期格式错误!"
        txtStartDate.SetFocus
    End If
End Sub

Private Sub txtEndDate_LostFocus()
    Dim tmp As String
    
    If Me.ActiveControl.Name = "cmdRef2" Then
        Exit Sub
    End If
    
    tmp = txtEndDate.Text
    If tmp = "" Then
    
    ElseIf tmp <> "" And bCheckDate(tmp) Then
        txtEndDate.Text = tmp
    Else
        txtEndDate.SelStart = 0
        txtEndDate.SelLength = Len(txtEndDate.Text)
        MsgBox "日期格式错误!"
        txtEndDate.SetFocus
    End If
End Sub

'载入操作员列表
Public Sub FillUser()
    Dim rs As adodb.Recordset
    
    If zjLogInfo.GetAccInfo(120, rs) Then
        While Not rs.EOF
            cboCheck.AddItem rs!cUser_Name
            cboBill.AddItem rs!cUser_Name
            rs.MoveNext
        Wend
        rs.Close
    End If
End Sub

'载入单据类型
Private Sub FillVchStyle()
    Dim con As New adodb.Connection
    Dim rs As New adodb.Recordset
    Dim sql As String
    Dim cnt As Integer
    
    con.CursorLocation = adUseClient
    con.ConnectionString = g_sDataSourceName
    con.Open
    cnt = 0
    sql = "select scaption,iid from fd_entities where iBIType=24 or ibitype=27 or ibitype=28 or iBIType=25 or ibitype=26"
    Set rs = con.Execute(sql)
    While Not rs.EOF
        cboVchStyle.AddItem rs!scaption
        cboVchStyle.ItemData(cnt) = rs!iID
        cnt = cnt + 1
        rs.MoveNext
    Wend
    If cnt <> 0 Then
        cboVchStyle.ListIndex = 0
    End If
    rs.Close
    con.Close
End Sub

'载入
Private Sub FillUnitName()
    Dim con As New adodb.Connection
    Dim rs As New adodb.Recordset
    Dim sql As String
    Dim cnt As Integer
    
    con.CursorLocation = adUseClient
    con.ConnectionString = g_sDataSourceName
    con.Open
    cnt = 0
    sql = "SELECT accunit_id, cUnitName FROM FD_AccUnit"
    Set rs = con.Execute(sql)
    While Not rs.EOF
        cboUnitName.AddItem rs!cUnitName
        unitID.Add "" & rs!accunit_id, "" & cnt
        cnt = cnt + 1
        rs.MoveNext
    Wend
    rs.Close
    con.Close
End Sub

'检查完整性
Private Function GetQuery() As String
    Dim tmp As String
    
    '单据类型
    GetQuery = ""
    If Trim(cboVchStyle.Text) <> "" Then
        GetQuery = " substring(transactions_id,1,2)='" & cboVchStyle.ItemData(cboVchStyle.ListIndex) & "' "
    End If
    '单据编号
    tmp = Trim(txtStartID.Text)
    If tmp <> "" Then
        If GetQuery <> "" Then
            GetQuery = GetQuery & " and transactions_code>='" & tmp & "' "
        Else
            GetQuery = " transactions_code>='" & tmp & "' "
        End If
    End If
    
    tmp = Trim(txtEndID.Text)
    If tmp <> "" Then
        If GetQuery <> "" Then
            GetQuery = GetQuery & " and transactions_code<='" & tmp & "' "
        Else
            GetQuery = " transactions_code<='" & tmp & "' "
        End If
    End If
    '单位名称
    If Trim(cboUnitName.Text) <> "" Then
        If GetQuery <> "" Then
            GetQuery = GetQuery & " and t3.accunit_id='" & unitID(cboUnitName.ListIndex + 1) & "' or t4.accunit_id=' " & unitID(cboUnitName.ListIndex + 1) & "'"
        Else
            GetQuery = " t3.accunit_id='" & unitID(cboUnitName.ListIndex + 1) & "' or t4.accunit_id=' " & unitID(cboUnitName.ListIndex + 1) & "'"
        End If
    End If
    '日期
    tmp = Trim(txtStartDate.Text)
    If tmp <> "" Then
        If GetQuery <> "" Then
            GetQuery = GetQuery & " and bill_date>='" & tmp & "' "
        Else
            GetQuery = " bill_date>='" & tmp & "' "
        End If
    End If
    
    tmp = Trim(txtEndDate.Text)
    If tmp <> "" Then
        If GetQuery <> "" Then
            GetQuery = GetQuery & " and bill_date<='" & tmp & "' "
        Else
            GetQuery = " bill_date<='" & tmp & "' "
        End If
    End If
    '制单人
    tmp = Trim(cboBill.Text)
    If tmp <> "" Then
        If GetQuery <> "" Then
            GetQuery = GetQuery & " and bill_name='" & tmp & "' "
        Else
            GetQuery = " bill_name='" & tmp & "' "
        End If
    End If
    '审核人
    tmp = Trim(cboCheck.Text)
    If tmp <> "" Then
        If GetQuery <> "" Then
            GetQuery = GetQuery & " and check_name='" & tmp & "' "
        Else
            GetQuery = " check_name='" & tmp & "' "
        End If
    End If
    '
    If GetQuery <> "" Then
        GetQuery = "where check_name  is not null and pz_code is null and book_name is null and " & GetQuery
    Else
        GetQuery = "where check_name  is not null and pz_code is null and book_name is null "
    End If
End Function

'检查日期
Private Function bCheckField() As Boolean
    If txtEndDate <> "" And txtStartDate <> "" Then
        If DateDiff("d", CDate(txtEndDate.Text), CDate(txtStartDate)) >= 0 Then
            MsgBox "结束日期不应小于起始日期!!"
            txtEndDate.SelStart = 0
            txtEndDate.SelLength = Len(txtEndDate.Text)
            txtEndDate.SetFocus
            Exit Function
        End If
    End If
    
    bCheckField = True
End Function