企业管理

开发平台：
Visual Basic

ʰ：源码内容
							VERSION 5.00
Begin VB.Form YH_FrmDztj 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "自动对帐"
   ClientHeight    =   2415
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3765
   HelpContextID   =   5103
   Icon            =   "银行_对帐条件.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2415
   ScaleWidth      =   3765
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton Command3 
      Height          =   300
      Left            =   3360
      Picture         =   "银行_对帐条件.frx":1042
      Style           =   1  'Graphical
      TabIndex        =   9
      Top             =   60
      Width           =   300
   End
   Begin VB.TextBox Text2 
      Height          =   285
      Left            =   930
      TabIndex        =   8
      Top             =   60
      Width           =   2445
   End
   Begin VB.CommandButton Command2 
      Caption         =   "取消(&C)"
      Height          =   300
      Left            =   2580
      TabIndex        =   7
      Top             =   2040
      Width           =   1120
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确定(&O)"
      Height          =   300
      Left            =   1380
      TabIndex        =   6
      Top             =   2040
      Width           =   1120
   End
   Begin VB.Frame Frame1 
      Caption         =   "对帐条件"
      Height          =   1545
      Left            =   60
      TabIndex        =   1
      Top             =   390
      Width           =   3645
      Begin VB.TextBox Text1 
         Height          =   285
         Left            =   1560
         MaxLength       =   3
         TabIndex        =   10
         Text            =   "12"
         Top             =   210
         Width           =   465
      End
      Begin VB.CheckBox Check4 
         Caption         =   "方向相反,金额相同"
         Enabled         =   0   'False
         Height          =   345
         Left            =   510
         TabIndex        =   5
         Top             =   1110
         Value           =   1  'Checked
         Width           =   2415
      End
      Begin VB.CheckBox Check3 
         Caption         =   "结算票号相同"
         Height          =   315
         Left            =   510
         TabIndex        =   4
         Top             =   810
         Value           =   1  'Checked
         Width           =   2265
      End
      Begin VB.CheckBox Check2 
         Caption         =   "结算方式相同"
         Height          =   255
         Left            =   510
         TabIndex        =   3
         Top             =   540
         Value           =   1  'Checked
         Width           =   2595
      End
      Begin VB.CheckBox Check1 
         Caption         =   "日期相差        天之内"
         Height          =   195
         Left            =   510
         TabIndex        =   2
         Top             =   270
         Value           =   1  'Checked
         Width           =   2775
      End
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "截止日期:"
      Height          =   180
      Index           =   0
      Left            =   90
      TabIndex        =   0
      Top             =   105
      Width           =   810
   End
End
Attribute VB_Name = "YH_FrmDztj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*************************************************************
'*    模 块 名 称 :银行对帐条件
'*    功 能 描 述 :进行银行勾对
'*    程序员姓名  : xjl
'*    最后修改人  : xjl
'*    最后修改时间:2000/11/07
'*    备        注:
'*************************************************************
Dim Textvar() As Variant                 '存储变体型文本框信息
Dim Textboolean() As Boolean             '存储布尔型文本框信息
Dim Textint() As Integer                 '存储整型文本框信息
Dim Textstr() As String                  '存储字符型文本框信息
Dim Max_Text_Index As Integer            '最大录入文本框索引值
Dim TextGroupCode As String              '文本框录入分组编码
Dim TextValiLock As Boolean              '文本框失去焦点是否进行有效性控制判断
Dim TextValiJudgeLock() As Boolean       '文本框录入有效性判断控制锁
Dim CurTextIndex As Integer              '当前文本框索引值
Dim TextChangeLock As Boolean            '文本框内容变换控制锁
Dim Bln_Cancel As Boolean                '取消按钮信息传递
Private Sub Command1_Click()
    Dim RecTemp As New ADODB.Recordset
    Dim Recfind As New ADODB.Recordset
    Dim RecGrid As New ADODB.Recordset
    Dim Sqlstr As String
    '日期检查
    If Trim(Text2) <> "" Then
        If CheckDate = False Then Exit Sub
    End If
    Screen.MousePointer = 11
    If RecTemp.State = 1 Then RecTemp.Close
    '银行对帐单
    If Text2 <> "" Then
        Sqlstr = "select BankBillID,Ccode,BillDate,Digest,SScode,BillNo,Jfje,Dfje,RecType,Balance,BCheckFlag,HandWorkFlag,BDelete " _
        & "from cwzz_bankbill where RecType=2 and billdate<='" & Text2.Text & "' " _
        & "and bcheckflag=0 and bdelete=0 and ccode='" & Val(YH_FrmXzkm.Combo1.Text) & "' "
    Else
        Sqlstr = "select BankBillID,Ccode,BillDate,Digest,SScode,BillNo,Jfje,Dfje,RecType,Balance,BCheckFlag,HandWorkFlag,BDelete " _
        & "from cwzz_bankbill where RecType=2 and Convert(Char(6),billdate,112)<='" & CStr(Trim(Xtyear)) + CStr(Trim(Xtmm)) & "' " _
        & "and bcheckflag=0 and bdelete=0 and ccode='" & Val(YH_FrmXzkm.Combo1.Text) & "' "
        
    End If
    RecTemp.Open Sqlstr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    Do While Not RecTemp.EOF()
        Sqlstr = ""
        If Check1.Value = 1 Then
            Sqlstr = Sqlstr + "ddate<='" & CDate(RecTemp.Fields("BILLDATE")) + Text1.Text & "' And ddate>='" & CDate(RecTemp.Fields("BILLDATE")) - Text1.Text & "'"
        End If
        If Check2.Value = 1 Then
            If Sqlstr = "" Then
                Sqlstr = "sscode='" & Trim(RecTemp.Fields("sscode")) & "'"
            Else
                Sqlstr = Sqlstr + " and sscode='" & Trim(RecTemp.Fields("sscode")) & "'"
            End If
        End If
        If Check3.Value = 1 Then
            If Sqlstr = "" Then
                Sqlstr = "billno='" & Trim(RecTemp.Fields("billno")) & "'"
            Else
                Sqlstr = Sqlstr + "and billno='" & Trim(RecTemp.Fields("billno")) & "'"
            End If
        End If
        
        
        '单位日记帐期初
        If Recfind.State = 1 Then Recfind.Close
        If Sqlstr = "" Then
            Recfind.Open "select * from cwzz_rjznotcheck where RecType<>0 and BCheckFlag=0 and bdelete=0 and ccode='" & Val(YH_FrmXzkm.Combo1.Text) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        Else
            Recfind.Open "select * from cwzz_rjznotcheck where " & Sqlstr & " and BCheckFlag=0 and bdelete=0 and RecType<>0 and ccode='" & Val(YH_FrmXzkm.Combo1.Text) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        End If
        Do While Not Recfind.EOF()
            If RecTemp.Fields("jfje") = Recfind.Fields("dfje") And RecTemp.Fields("dfje") = Recfind.Fields("jfje") Then
                RecTemp.Fields("bcheckflag") = 1
                RecTemp.Update
                Recfind.Fields("bcheckflag") = 1
                Recfind.Update
                GoTo LABLE:
            End If
            Recfind.MoveNext
        Loop
        '发生业务
        If Recfind.State = 1 Then Recfind.Close
        If Sqlstr = "" Then
            Recfind.Open "select * from Cwzz_V_AccVouch where bdelete=0  " _
            & "and BCheckFlag=0 and ccode='" & Val(YH_FrmXzkm.Combo1.Text) & "' " _
            & "And Convert(Char(8),Ddate,112)>=(Select Convert(char(8),ddate,112) From " _
            & "cwzz_rjznotcheck Where rectype=0 And Ccode=" & Val(YH_FrmXzkm.Combo1.Text) & ") " _
            & "And Convert(Char(6),Ddate,112)<= " _
            & "(select Convert(Char(6),max(qsrq),112) from gy_kjrlb where cwzzjzbz='1')", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        Else
            Recfind.Open "select * from Cwzz_V_AccVouch where " & Sqlstr & " and bdelete=0  " _
            & "and BCheckFlag=0 and ccode='" & Val(YH_FrmXzkm.Combo1.Text) & "' " _
            & "And Convert(Char(8),Ddate,112)>=(Select Convert(char(8),ddate,112) From " _
            & "cwzz_rjznotcheck Where rectype=0 And Ccode=" & Val(YH_FrmXzkm.Combo1.Text) & ") " _
            & "And Convert(Char(6),Ddate,112)<= " _
            & "(select Convert(Char(6),max(qsrq),112) from Gy_kjrlb where cwzzjzbz='1')", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        End If
        Do While Not Recfind.EOF()
            If RecGrid.State = 1 Then RecGrid.Close
            RecGrid.Open "select * from cwzz_accvouchSub where SerialID='" & Recfind.Fields("SerialID") & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            Do While Not RecGrid.EOF()
                If RecTemp.Fields("jfje") = RecGrid.Fields("dfje") And RecTemp.Fields("dfje") = RecGrid.Fields("jfje") Then
                    RecTemp.Fields("bcheckflag") = 1
                    RecTemp.Update
                    RecGrid.Fields("bcheckflag") = 1
                    RecGrid.Update
                    GoTo LABLE:
                End If
                RecGrid.MoveNext
            Loop
            Recfind.MoveNext
        Loop
LABLE:
        RecTemp.MoveNext
    Loop
    
    '因为对帐单期初与对帐单主向相反
    If RecTemp.State = 1 Then RecTemp.Close
    '银行对帐单
    If Text2 <> "" Then
        Sqlstr = "select BankBillID,Ccode,BillDate,Digest,SScode,BillNo,Jfje,Dfje,RecType,Balance,BCheckFlag,HandWorkFlag,BDelete " _
        & "from cwzz_bankbill where RecType=1 and billdate<='" & Text2.Text & "' " _
        & "and bcheckflag=0 and bdelete=0 and ccode='" & Val(YH_FrmXzkm.Combo1.Text) & "' "
    Else
        Sqlstr = "select BankBillID,Ccode,BillDate,Digest,SScode,BillNo,Jfje,Dfje,RecType,Balance,BCheckFlag,HandWorkFlag,BDelete " _
        & "from cwzz_bankbill where RecType=1 and Convert(Char(6),billdate,112)<='" & CStr(Trim(Xtyear)) + CStr(Trim(Xtmm)) & "' " _
        & "and bcheckflag=0 and bdelete=0 and ccode='" & Val(YH_FrmXzkm.Combo1.Text) & "' "
        
    End If
    RecTemp.Open Sqlstr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    Do While Not RecTemp.EOF()
        Sqlstr = ""
        If Check1.Value = 1 Then
            Sqlstr = Sqlstr + "ddate<='" & CDate(RecTemp.Fields("BILLDATE")) + Text1.Text & "' And ddate>='" & CDate(RecTemp.Fields("BILLDATE")) - Text1.Text & "'"
        End If
        If Check2.Value = 1 Then
            If Sqlstr = "" Then
                Sqlstr = "sscode='" & Trim(RecTemp.Fields("sscode")) & "'"
            Else
                Sqlstr = Sqlstr + " and sscode='" & Trim(RecTemp.Fields("sscode")) & "'"
            End If
        End If
        If Check3.Value = 1 Then
            If Sqlstr = "" Then
                Sqlstr = "billno='" & Trim(RecTemp.Fields("billno")) & "'"
            Else
                Sqlstr = Sqlstr + "and billno='" & Trim(RecTemp.Fields("billno")) & "'"
            End If
        End If
        
        
        '单位日记帐期初
        If Recfind.State = 1 Then Recfind.Close
        If Sqlstr = "" Then
            Recfind.Open "select * from cwzz_rjznotcheck where RecType<>0 and BCheckFlag=0 and bdelete=0 and ccode='" & Val(YH_FrmXzkm.Combo1.Text) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        Else
            Recfind.Open "select * from cwzz_rjznotcheck where " & Sqlstr & " and BCheckFlag=0 and bdelete=0 and RecType<>0 and ccode='" & Val(YH_FrmXzkm.Combo1.Text) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        End If
        Do While Not Recfind.EOF()
            If RecTemp.Fields("Dfje") = Recfind.Fields("dfje") And RecTemp.Fields("Jfje") = Recfind.Fields("jfje") Then
                RecTemp.Fields("bcheckflag") = 1
                RecTemp.Update
                Recfind.Fields("bcheckflag") = 1
                Recfind.Update
                GoTo LABLE1:
            End If
            Recfind.MoveNext
        Loop
        '发生业务
        If Recfind.State = 1 Then Recfind.Close
        If Sqlstr = "" Then
            Recfind.Open "select * from Cwzz_V_AccVouch where bdelete=0  " _
            & "and BCheckFlag=0 and ccode='" & Val(YH_FrmXzkm.Combo1.Text) & "' " _
            & "And Convert(Char(8),Ddate,112)>=(Select Convert(char(8),ddate,112) From " _
            & "cwzz_rjznotcheck Where rectype=0 And Ccode=" & Val(YH_FrmXzkm.Combo1.Text) & ") " _
            & "And Convert(Char(6),Ddate,112)<= " _
            & "(select Convert(Char(6),max(qsrq),112) from gy_kjrlb where cwzzjzbz='1')", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        Else
            Recfind.Open "select * from Cwzz_V_AccVouch where " & Sqlstr & " and bdelete=0  " _
            & "and BCheckFlag=0 and ccode='" & Val(YH_FrmXzkm.Combo1.Text) & "' " _
            & "And Convert(Char(8),Ddate,112)>=(Select Convert(char(8),ddate,112) From " _
            & "cwzz_rjznotcheck Where rectype=0 And Ccode=" & Val(YH_FrmXzkm.Combo1.Text) & ") " _
            & "And Convert(Char(6),Ddate,112)<= " _
            & "(select Convert(Char(6),max(qsrq),112) from Gy_kjrlb where cwzzjzbz='1')", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        End If
        Do While Not Recfind.EOF()
            If RecGrid.State = 1 Then RecGrid.Close
            RecGrid.Open "select * from cwzz_accvouchsub where SerialID='" & Recfind.Fields("SerialID") & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            Do While Not RecGrid.EOF()
                If RecTemp.Fields("Dfje") = RecGrid.Fields("dfje") And RecTemp.Fields("Jfje") = RecGrid.Fields("jfje") Then
                    RecTemp.Fields("bcheckflag") = 1
                    RecTemp.Update
                    RecGrid.Fields("bcheckflag") = 1
                    RecGrid.Update
                    GoTo LABLE1:
                End If
                RecGrid.MoveNext
            Loop
            Recfind.MoveNext
        Loop
LABLE1:
        RecTemp.MoveNext
    Loop
    
    Screen.MousePointer = 0
    Unload Me
End Sub
Private Sub Command2_Click()
    Unload Me
End Sub
Private Sub Command3_Click()
    XT_calendar.Show 1
    Text2.Text = Xtfhcs
    Text2.Tag = Xtfhcsfz
    Text2.SetFocus
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii > 47 And KeyAscii < 57 Or KeyAscii = 8 Then
        
    Else
        KeyAscii = 0
    End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
    Case Asc("a") To Asc("z"), Asc("A") To Asc("Z")
        KeyAscii = 0
    End Select
End Sub
'===========自定义============
Function CheckDate() As Boolean
    '日期检验
    Dim Tsxx As String
    If Not IsDate(Text2.Text) Then
        CheckDate = False
        Tsxx = "日期格式不正确！"
        Call Xtxxts(Tsxx, 0, 1)
        With Text2
            .SetFocus
            .SelStart = 0
            .SelLength = Len(.Text)
        End With
    Else
        CheckDate = True
    End If
End Function

						