frmyh_yhwdzmx.frm

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

      Begin VB.Menu line11 
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "退出"
      End
   End
   Begin VB.Menu Help 
      Caption         =   "帮助"
   End
End
Attribute VB_Name = "frmYH_YhwdzMx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'2001.01.22肖兆芹修改
Option Explicit

'以下一段常量用于窗体frm_print的CELL打印
'-------------------------------------------------------------
'Cell单元格对齐方式: 33 = 左对齐, 34 = 右对齐, 36 = 居中对齐;

'银行对账单
Const ROWS_PAGE_YH = 36                '每页行数

Const COL_START_YH = 1                 '开始列
Const COL_RQ = 1                       '日期
Const COL_JSFS_YH = 2                  '结算方式
Const COL_BILL_NUMBER_YH = 3           '票号
Const COL_DEBIT_MONEY_YH = 4           '借方金额
Const COL_CREDIT_MONEY_YH = 5          '贷方金额
Const COL_LQBZ_YH = 6                  '两清标志
Const COL_ZY = 7                       '摘要
Const COL_END_YH = 7                   '结束列

'缺省列宽
'CELL  1单元长度 = 3.8mm
Const COLWIDTH_YH = "85,70,100,140,140,40,140"


'单位日记账
Const ROWS_PAGE_DW = 28                '每页行数

Const COL_START_DW = 1                 '开始列
Const COL_PZRQ = 1                     '凭证日期
Const COL_BILL_DATE = 2                '票据日期
Const COL_JSFS_DW = 3                  '结算方式
Const COL_BILL_NUMBER_DW = 4           '票号
Const COL_DEBIT_MONEY_DW = 5           '借方金额
Const COL_CREDIT_MONEY_DW = 6          '贷方金额
Const COL_LQBZ_DW = 7                  '两清标志
Const COL_PZZL = 8                     '凭证种类
Const COL_PZBH = 9                     '凭证编号
Const COL_PZZY = 10                     '凭证摘要
Const COL_END_DW = 10                   '结束列

'缺省列宽
'CELL  1单元长度 = 3.8mm
Const COLWIDTH_DW = "85,85,100,80,140,140,40,80,80,200"

Const ROW_TITLE = 1                 '标题
Const ROW_BLANK = 2                 '空白行
Const ROW_SUBJNAME = 3              '页眉
Const ROW_HEAD1 = 4                 '页标头行
Const ROW_GRID_START = 5            '表格开始行
Const CRB_LINE = vbBlack            '表格线颜色

Dim sEnterName As String                            '单位名称
Dim IsChangeCurrentTable As Boolean                 '是否改变当前表格中的内容
Dim frmP As frmPrint                                '通用打印窗体(CELL)
'-------------------------------------------------------------
Dim rstTemp As ADODB.Recordset
Dim sSQL As String
Dim sSQLYhdzd As String
Dim sSQLDwrjz As String
Dim Yhdzqyrq As String                      '银行对账启用日期
Dim i As Integer
Dim j As Integer
Dim KmdmSelect As String                    '当前选中的科目代码
Dim sKmName As String
Dim sDzdRq As String
Dim sQueryStr As String                     '查询条件字符串
Dim bFormload As Boolean                    '当前是否在窗体的引导状态
Dim bTheSameYear As String                  '0 -- 注册年份小于银行对账启用年份
                                            '1 -- 注册年份等于银行对账启用年份
                                            '2 -- 注册年份大于银行对账启用年份
                                            
Public Property Let usSubjectCode(ByVal sCode As String)
   KmdmSelect = sCode
End Property
Public Property Let usSubjectName(ByVal sName As String)
        sKmName = sName
End Property
Public Property Let usDzdJzrq(ByVal sdate As String)
        sDzdRq = sdate
End Property

Private Sub form_load()
    Dim s As String
    fMainForm.MousePointer = vbHourglass
    IsChangeCurrentTable = True
    bFormload = True
    
    lblKmmc.Caption = "科目名称：(" & KmdmSelect & ")" & sKmName
    cboViewselect.AddItem "显示全部"
    cboViewselect.ListIndex = 0
    '''''''''''''''''
     If GetKmWbdw(KmdmSelect) = "" Then
        s = "je"
    Else
        s = "wb"
    End If
    ''''''''''''''''
    stbYhdzcx.Tab = 0
    With stbYhdzcx
        If .Tab = 0 Then
            lblYhdzmc.Caption = "银行对账单"
        Else
            lblYhdzmc.Caption = "单位日记账"
        End If
    End With
    
    '从银行对账启用日期表中取出银行对账启用日期
    Set rstTemp = New ADODB.Recordset
    rstTemp.CursorLocation = adUseClient
    sSQL = "SELECT * FROM tZW_Yhdzqyrq WHERE kmdm = '" & KmdmSelect & "'"
    rstTemp.Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
    With rstTemp
        If Not (.EOF And .BOF) Then
            If Year(.Fields("qyrq").value) < CInt(glo.sOperateYear) Then
                bTheSameYear = 0
            ElseIf Year(.Fields("qyrq").value) = CInt(glo.sOperateYear) Then
                bTheSameYear = 1
            Else
                bTheSameYear = 2
            End If
            Yhdzqyrq = Format(.Fields("qyrq").value, "yyyy-mm-dd")
        Else
            bTheSameYear = 0
        End If
    End With
    '==================================8.15===yao=======================================
'    If g_FLAT = "SQL" Then
'       sSQLYhdzd = "SELECT * FROM tZW_Yhdzd" & glo.sOperateYear & _
'                " WHERE kmdm = '" & KmdmSelect & _
'                "' AND qcbz <> 0 AND hxbz = 0  and rq <=" & sDzdRq & " ORDER BY rq"
'    Else
'        sSQLYhdzd = "SELECT * FROM tZW_Yhdzd" & glo.sOperateYear & _
'                " WHERE kmdm = '" & KmdmSelect & _
'                "' AND qcbz <> 0 AND hxbz = 0  and  rq<= TO_DATE('" & sDzdRq & ",'YYYY-MM-DD') " & " ORDER BY rq"
'
'    End If
    If g_FLAT = "SQL" Then
       sSQLYhdzd = "SELECT * FROM tZW_Yhdzd" & glo.sOperateYear & _
                " WHERE kmdm = '" & KmdmSelect & _
                "' AND qcbz <> 0 AND hxbz = 0  and rq <='" & sDzdRq & "' ORDER BY rq,jsfsCode,Bill"
    Else
        sSQLYhdzd = "SELECT * FROM tZW_Yhdzd" & glo.sOperateYear & _
                " WHERE kmdm = '" & KmdmSelect & _
                "' AND qcbz <> 0 AND hxbz = 0  and  rq<= TO_DATE('" & sDzdRq & "','YYYY-MM-DD') " & " ORDER BY rq,jsfsCode,Bill"
    
    End If
    
   '==============================================================================
    '如果当前注册年份和银行对账启用年份相同
    sQueryStr = ""
    If bTheSameYear = 1 Then
        sQueryStr = " WHERE kmdm = '" & KmdmSelect & _
                    "' AND ((kjqj >= " & Month(CDate(Yhdzqyrq)) & _
                    " AND kjqj <= 12)" & " OR kjqj = 21)" & _
                    " AND yhdz_hxbz = 0"
    ElseIf bTheSameYear = 2 Then
        sQueryStr = " WHERE kmdm = '" & KmdmSelect & _
                    "' AND ((kjqj >= 1 AND kjqj <= 12)" & " OR kjqj = 21)" & _
                    " AND yhdz_hxbz = 0"
    End If
    
    '=========================8.15====yao========================
    
'    If g_FLAT = "SQL" Then
'        sQueryStr = sQueryStr & " and pzrq <=" & sDzdRq
'    Else
'        sQueryStr = sQueryStr & " and  pzrq<= TO_DATE('" & sDzdRq & ",'YYYY-MM-DD') "
'    End If
'
    If g_FLAT = "SQL" Then
        sQueryStr = sQueryStr & " and pzrq <='" & sDzdRq & "'"
    Else
        sQueryStr = sQueryStr & " and  pzrq<= TO_DATE('" & sDzdRq & "','YYYY-MM-DD') "
    End If
    '==============================================================
    
    sSQLDwrjz = "SELECT pzzl,pzbh,pzrq,pzzy,fx," + s + " je,yhdz_jsfscode," & _
                "yhdz_bill,yhdz_date,yhdz_lqbz" & _
                " FROM tZW_Pzsj" & glo.sOperateYear & sQueryStr & _
                " ORDER BY pzrq"
    Call SetHead
    Call FillGridYhdzd(sSQLYhdzd)
    Call FillGridDwrjz(sSQLDwrjz)
    
    '------------------------------
    '得到当前账套的单位名称
    sEnterName = GetDWMC
    If sEnterName = "" Then
        MsgBox "缺少单位名称！", vbInformation
        Exit Sub
    End If
    
    '根据当前MSFLEXGRID表格生成CELL表格
    If IsChangeCurrentTable Then
        IsChangeCurrentTable = False
        Call DrawCellTable
    End If
    
    '------------------------------
    bFormload = False
    Load frmYH_Yhcxtj
    fMainForm.MousePointer = vbDefault
    
End Sub

'设置表头
Private Sub SetHead()
    With mfgYhdzd
        .ColWidth(0) = 1200
        .ColWidth(1) = 1000
        .ColWidth(2) = 1000
        .ColWidth(3) = 1800
        .ColWidth(4) = 1800
        .ColWidth(5) = 600
        .ColWidth(6) = 2000
        
        .ColAlignment(0) = 4
        .ColAlignment(1) = 4
        .ColAlignment(2) = 4
        .ColAlignment(3) = 7
        .ColAlignment(4) = 7
        .ColAlignment(5) = 4
        .ColAlignment(6) = 1
        .row = 0
        .RowHeight(0) = 300
        For j = 0 To .Cols - 1
            .col = j
            .CellAlignment = 4
        Next j
    End With
    
    With mfgDwrjz
        .ColWidth(0) = 1200
        .ColWidth(1) = 1200
        .ColWidth(2) = 1000
        .ColWidth(3) = 1000
        .ColWidth(4) = 1800
        .ColWidth(5) = 1800
        .ColWidth(6) = 600
        .ColWidth(7) = 1000
        .ColWidth(8) = 1000
        .ColWidth(9) = 2000
        
        .ColAlignment(0) = 4
        .ColAlignment(1) = 4
        .ColAlignment(2) = 4
        .ColAlignment(3) = 4
        .ColAlignment(4) = 7
        .ColAlignment(5) = 7
        .ColAlignment(6) = 4
        .ColAlignment(7) = 4
        .ColAlignment(8) = 4
        .ColAlignment(9) = 1
        .row = 0
        .RowHeight(0) = 300
        For j = 0 To .Cols - 1
            .col = j
            .CellAlignment = 4
        Next j
    End With
End Sub

'填充银行对账单
Private Sub FillGridYhdzd(ByVal sSQLYhdzd As String)
    Dim rstYhdzd As ADODB.Recordset
    Dim dTotalYhJfje As Double                  '银行方合计借方金额
    Dim dTotalYhDfje As Double                  '银行方合计贷方金额