frmyh_yhdz.frm

一个用VB写的财务软件源码

         Weight          =   700
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   3825
      TabIndex        =   8
      Top             =   630
      Width           =   1305
   End
   Begin VB.Label lblYhdzd 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      Caption         =   "银行对账单"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   3795
      TabIndex        =   9
      Top             =   3300
      Width           =   1305
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件(&F)"
      Begin VB.Menu mnuExit 
         Caption         =   "退出(&X)"
      End
   End
   Begin VB.Menu mnuBank 
      Caption         =   "对账(&B)"
      Begin VB.Menu mnuBankCollate 
         Caption         =   "对账"
         Shortcut        =   ^Z
      End
      Begin VB.Menu mnuCancel 
         Caption         =   "撤消"
         Shortcut        =   ^C
      End
      Begin VB.Menu mnuLine1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuFilter 
         Caption         =   "筛选"
         Shortcut        =   ^L
      End
      Begin VB.Menu mnuMatch 
         Caption         =   "匹配"
         Shortcut        =   ^M
      End
      Begin VB.Menu mnuLine2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuCheck 
         Caption         =   "检查"
         Shortcut        =   ^K
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "帮助(&H)"
   End
End
Attribute VB_Name = "frmYH_Yhdz"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Base 1
Dim rstTemp As ADODB.Recordset
Dim adoCmd As ADODB.Command
Dim sSQL As String
Dim sSQLDwf As String
Dim sSQLYhf As String
Dim sLqbz As String
Dim Yhdzqyrq As String                  '银行对账启用日期
Dim i As Integer
Dim j As Integer
Dim IsRefresh As Boolean                '当前是否在刷新状态
Dim IsSelect As Boolean                 '当前屏幕上的记录是否处在筛选状态
Dim IsPress As Boolean                  '当前屏幕上的记录是否处在匹配状态
Dim NotLqDwfRow As Integer              '当前没有两清的单位方记录
Dim NotLqYhfRow As Integer              '当前没有两清的银行方记录

Dim YhdzdRq As String                   '未两清的银行对账单的日期
Dim YhdzdJsfsCode As String             '未两清的银行对账单的结算方式的代码
Dim YhdzdBill As String                 '未两清的银行对账单的票号
Dim YhdzdFx As String                   '未两清的银行对账单的方向
Dim YhdzdJe As Double                   '未两清的银行对账单的金额
Dim DwrjzPzrq As String                 '未两清的单位日记账的日期
Dim DwrjzJsfsCode As String             '未两清的单位日记账的结算方式的代码
Dim DwrjzBill As String                 '未两清的单位日记账的票号
Dim DwrjzFx As String                   '未两清的单位日记账的方向
Dim DwrjzJe As Double                   '未两清的单位日记账的金额

Public MaxJzrq As String                '最大银行对账截止日期



'已达账检查按钮被改变
Private Sub chkYdz_Click()

    '如果不显示已达账
    If chkYdz.value = 0 Then
        With mfgDwrjz
            For i = 1 To .Rows - 1
                If .TextMatrix(i, 9) <> "" Then
                    .RowHeight(i) = 0
                End If
            Next i
        End With
        
        With mfgYhdzd
            For i = 1 To .Rows - 1
                If .TextMatrix(i, 6) <> "" Then
                    .RowHeight(i) = 0
                End If
            Next i
        End With
    '否则显示已达账
    Else
        With mfgDwrjz
            For i = 1 To .Rows - 1
                If .TextMatrix(i, 9) <> "" Then
                    .RowHeight(i) = 225
                End If
            Next i
        End With
        
        With mfgYhdzd
            For i = 1 To .Rows - 1
                If .TextMatrix(i, 6) <> "" Then
                    .RowHeight(i) = 225
                End If
            Next i
        End With
    End If
End Sub

Private Sub form_load()

    fMainForm.MousePointer = vbHourglass
    IsPress = True
    IsSelect = False
    
    '从银行对账启用日期表中取出银行对账启用日期、截止日期,
    '如果银行对账启用日期等于当前注册年份, 则yhdzqyrq等于字段"qyrq"值;
    '否则yhdzqyrq等于"当前注册年份-01-01";
    Set rstTemp = New ADODB.Recordset
    rstTemp.CursorLocation = adUseClient
    sSQL = "SELECT * FROM tZW_Yhdzqyrq WHERE kmdm = '" & frmYH_Yhkmxz.kmdm & "'"
    rstTemp.Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
    With rstTemp
        If .RecordCount > 0 Then
            If Year(.Fields("qyrq").value) = glo.sOperateYear Then
                Yhdzqyrq = Format(.Fields("qyrq").value, "yyyy-mm-dd")
                MaxJzrq = Format(.Fields("jzrq").value, "yyyy-mm-dd")
            Else
                Yhdzqyrq = glo.sOperateYear & "-01-01"
                MaxJzrq = glo.sOperateYear - 1 & "-12-31"
            End If
        Else
            Yhdzqyrq = glo.sOperateYear & "-01-01"
            MaxJzrq = glo.sOperateYear - 1 & "-12-31"
        End If
    End With
    Set adoCmd = New ADODB.Command
    adoCmd.ActiveConnection = glo.cnnMain
    txtKmmc.text = "科目：" & frmYH_Yhkmxz.Kmmc & "(" & frmYH_Yhkmxz.kmdm & ")"
    If GetKmWbdw(frmYH_Yhkmxz.kmdm) = "" Then
        Select Case g_FLAT
            Case "SQL"
                sSQLDwf = "SELECT kjqj,pzzl,pzbh,jlhm,pzrq,pzzy,fx,je," & _
                        "yhdz_jsfscode,yhdz_bill,yhdz_date,yhdz_lqbz,yhdz_id" & _
                        " FROM tZW_Pzsj" & glo.sOperateYear & _
                        " WHERE kmdm = '" & frmYH_Yhkmxz.kmdm & _
                        "'  AND ((kjqj < 20 AND pzrq >= '" & _
                        Yhdzqyrq & "' AND xgbz = '2')  OR kjqj = 21)" & _
                        " AND yhdz_hxbz = 0 ORDER BY pzrq"
            Case "ORACLE"
                sSQLDwf = "SELECT kjqj,pzzl,pzbh,jlhm,pzrq,pzzy,fx,je," & _
                        "yhdz_jsfscode,yhdz_bill,yhdz_date,yhdz_lqbz,yhdz_id" & _
                        " FROM tZW_Pzsj" & glo.sOperateYear & _
                        " WHERE kmdm = '" & frmYH_Yhkmxz.kmdm & _
                        "' AND ((kjqj < 20 AND pzrq >= TO_DATE('" & _
                        Yhdzqyrq & "','YYYY-MM-DD') AND xgbz = '2') OR kjqj = 21)" & _
                        " AND yhdz_hxbz = 0 ORDER BY pzrq"
        End Select
    Else
        Select Case g_FLAT
            Case "SQL"
                sSQLDwf = "SELECT kjqj,pzzl,pzbh,jlhm,pzrq,pzzy,fx,wb," & _
                        "yhdz_jsfscode,yhdz_bill,yhdz_date,yhdz_lqbz,yhdz_id" & _
                        " FROM tZW_Pzsj" & glo.sOperateYear & _
                        " WHERE kmdm = '" & frmYH_Yhkmxz.kmdm & _
                        "' AND ((kjqj < 20 AND pzrq >= '" & _
                        Yhdzqyrq & "' AND xgbz = '2') OR kjqj = 21)" & _
                        " AND yhdz_hxbz = 0 And wb<>0 ORDER BY pzrq"
            Case "ORACLE"
                sSQLDwf = "SELECT kjqj,pzzl,pzbh,jlhm,pzrq,pzzy,fx,wb," & _
                        "yhdz_jsfscode,yhdz_bill,yhdz_date,yhdz_lqbz,yhdz_id" & _
                        " FROM tZW_Pzsj" & glo.sOperateYear & _
                        " WHERE kmdm = '" & frmYH_Yhkmxz.kmdm & _
                        "' AND ((kjqj < 20 AND pzrq >= TO_DATE('" & _
                        Yhdzqyrq & "','YYYY-MM-DD') AND xgbz = '2') OR kjqj = 21)" & _
                        " AND yhdz_hxbz = 0 And wb<>0 ORDER BY pzrq"
        End Select
    End If
        sSQLYhf = "SELECT id,rq,jsfscode,bill,fx,je,lqbz,zy" & _
                " FROM tZW_Yhdzd" & glo.sOperateYear & _
                " WHERE kmdm = '" & frmYH_Yhkmxz.kmdm & _
                "' AND qcbz <> 0 and hxbz = 0 ORDER BY rq,jsfsCode,Bill"
    Call SetHead
'    Debug.Print sSQLDwf
    Call FillGridDwf(sSQLDwf)
    Call FillGridYhf(sSQLYhf)
    Load frmYH_Yhcxtj
    Load frmYH_Yhdztj
    Load frmYH_YhdzPhCheck
    Load frmYH_Yhfdz
    fMainForm.MousePointer = vbDefault
End Sub

'设置表头
Private Sub SetHead()
    With mfgDwrjz
        .ColWidth(0) = 0
        .ColWidth(1) = 0
        .ColWidth(2) = 0
        .ColWidth(3) = 1200
        .ColWidth(4) = 1200
        .ColWidth(5) = 1800
        .ColWidth(6) = 1200
        .ColWidth(7) = 600
        .ColWidth(8) = 1800
        .ColWidth(9) = 600
        .ColWidth(10) = 1000
        .ColWidth(11) = 1000
        .ColWidth(12) = 3400
        
        .ColAlignment(0) = 4
        .ColAlignment(1) = 4
        .ColAlignment(2) = 4
        .ColAlignment(3) = 4
        .ColAlignment(4) = 4
        .ColAlignment(5) = 4
        .ColAlignment(6) = 4
        .ColAlignment(7) = 4
        .ColAlignment(8) = 7
        .ColAlignment(9) = 4
        .ColAlignment(10) = 4
        .ColAlignment(11) = 4
        .ColAlignment(12) = 1
        .Row = 0
        .RowHeight(0) = 400
        For j = 0 To .Cols - 1
            .Col = j
            .CellFontSize = 11
            .CellAlignment = 4
        Next j
    End With
    With mfgYhdzd
        .ColWidth(0) = 0
        .ColWidth(1) = 1200
        .ColWidth(2) = 1800
        .ColWidth(3) = 1200
        .ColWidth(4) = 600
        .ColWidth(5) = 1800
        .ColWidth(6) = 600
        .ColWidth(7) = 3400
        .ColAlignment(0) = 4
        .ColAlignment(1) = 4
        .ColAlignment(2) = 4
        .ColAlignment(3) = 4
        .ColAlignment(4) = 4
        .ColAlignment(5) = 7
        .ColAlignment(6) = 4
        .ColAlignment(7) = 1
        .Row = 0
        .RowHeight(0) = 400
        For j = 0 To .Cols - 1
            .Col = j
            .CellFontSize = 11
            .CellAlignment = 4
        Next j
    End With
End Sub

'填充单位日记账表格
Private Sub FillGridDwf(ByVal sSQLTempDwf As String)
    Dim s As String
    If GetKmWbdw(frmYH_Yhkmxz.kmdm) = "" Then
        s = "je"
    Else
        s = "wb"
    End If
    IsRefresh = True
    mfgDwrjz.Redraw = False
    Set rstTemp = New ADODB.Recordset
    rstTemp.CursorLocation = adUseClient
    rstTemp.Open sSQLTempDwf, glo.cnnMain, adOpenStatic, adLockReadOnly
    With rstTemp
        mfgDwrjz.Rows = 1
        If .RecordCount <> 0 Then
            .MoveFirst
            For i = 1 To .RecordCount
                If IsNull(.Fields("yhdz_lqbz").value) Then
                    sLqbz = ""
                ElseIf .Fields("yhdz_lqbz").value = 1 Then
                    sLqbz = "○"
                Else
                    sLqbz = "√"
                End If
                If FormatToDouble(.Fields(s).value) <> 0 Then
                    mfgDwrjz.AddItem .Fields("kjqj").value & vbTab & _
                                     .Fields("jlhm").value & vbTab & _
                                     .Fields("yhdz_id").value & vbTab & _
                                     Format(.Fields("pzrq").value, "yyyy-mm-dd") & vbTab & _
                                     Format(.Fields("yhdz_date").value, "yyyy-mm-dd") & vbTab & _
                                     Trim$("" & .Fields("yhdz_jsfsCode").value) + " " + GetJsfsName(Trim$("" & .Fields("yhdz_jsfsCode").value)) & vbTab & _
                                     Trim$("" & .Fields("yhdz_bill").value) & vbTab & _
                                     .Fields("fx").value & vbTab & _
                                     Format(.Fields(s).value, "##,##0.00") & vbTab & _
                                     sLqbz & vbTab & _
                                     Trim$("" & .Fields("pzzl").value) & vbTab & _
                                     .Fields("pzbh").value & vbTab & _
                                     Trim$("" & .Fields("pzzy").value) & vbTab & i