frmin_kmyetz.frm

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

'========================初始化Cll控件================
Public Sub InitCllControl()
Dim i As Integer
With cllBalance
    .Login "南京伊康计算机工程公司", "11010504", "0060-1733-7722-3004"
    cllPrint.Login "南京伊康计算机工程公司", "11010504", "0060-1733-7722-3004"
    .Visible = False
    .ResetContent '清除所有表页内容，并保留一张空表页
    .ShowSideLabel 0, 0 '不显示行标
    .ShowTopLabel 0, 0 '不显示列标
    .Mergecell = False '不可以用鼠标组合单元格
    .AllowDragdrop = False  '不允许拖动
    .ShowSheetLabel 0, 0 '不显示页标
    .WndBkColor = lDefaultColor '背景颜色
    .RdonlyCellColor = lReadonlyColor
    If bReadOnly Then
      .SetSelectMode 0, 2 '单元格为行选择模式
    Else
      .SetSelectMode 0, 1
    End If
    .CalcManaually = False '置否手工计算公式单元格中的公式
    .SetLeftCol 1 '设置当前最左边的列号
    .SetTopRow 1
    .WorkbookReadonly = bReadOnly '设置只读属性
    .AllowSizeColInGrid = True
    .SetCols iDataCols + iFixCols, 0 '设置总列数
'     '设置行高
    .SetDefaultRowHeight 0, 1, lRowHeight
     '设置列宽
     .SetColWidth 1, uSlWbLxCol.iWidth, uSlWbLxCol.iCol, 0
     .SetColWidth 1, uKmdmCol.iWidth, uKmdmCol.iCol, 0
     .SetColWidth 1, uKmmcCol.iWidth, uKmmcCol.iCol, 0
     .SetColWidth 1, uFxCol.iWidth, uFxCol.iCol, 0
     .SetColWidth 1, uNcSlCol.iWidth, uNcSlCol.iCol, 0
     .SetColWidth 1, uNcWbCol.iWidth, uNcWbCol.iCol, 0
     .SetColWidth 1, uNcJeCol.iWidth, uNcJeCol.iCol, 0
     .SetColWidth 1, uLjJslCol.iWidth, uLjJslCol.iCol, 0
     .SetColWidth 1, uLjJwbCol.iWidth, uLjJwbCol.iCol, 0
     .SetColWidth 1, uLjJjeCol.iWidth, uLjJjeCol.iCol, 0
     .SetColWidth 1, uLjDslCol.iWidth, uLjDslCol.iCol, 0
     .SetColWidth 1, uLjDwbCol.iWidth, uLjDwbCol.iCol, 0
     .SetColWidth 1, uLjDjeCol.iWidth, uLjDjeCol.iCol, 0
     .SetColWidth 1, uQcSlCol.iWidth, uQcSlCol.iCol, 0
     .SetColWidth 1, uQcWbCol.iWidth, uQcWbCol.iCol, 0
     .SetColWidth 1, uQcJeCol.iWidth, uQcJeCol.iCol, 0
'     .SetColWidth 1, uFzhshCol.iWidth, uFzhshCol.iCol, 0
'     .SetColWidth 1, uIsEndKMCol.iWidth, uIsEndKMCol.iCol, 0
      For i = 1 To iFixCols + iDataCols
          .SetCellAlign i, iFixRows, 0, 32 + 4 '固定行单元格显示方式水平垂直居中
          .SetCellInput i, iFixRows, 0, 5 '固定行只读
      Next
End With
Call pFillCllRow(1, "数量外币类型", "编码", "科目名称", "方向", "年初数量余额", "年初外币余额", "年 初 余 额" _
            , "累计借方数量", "累计借方外币", "累计借方金额", "累计贷方数量", "累计贷方外币", "累计贷方金额" _
            , "期初数量余额", "期初外币余额", "期 初 余 额") ', "辅助核算号", "是否末级科目")
End Sub

'==================装载数据到cll======================
Public Function InitLoadDataToCll() As Boolean
'    On Error GoTo Err
    Dim i As Integer
    Dim iRowNum As Integer '当前行
    Dim arrRowsStr() As String '当前行数据
    Dim rSt As New ADODB.Recordset  'tzw_km2003 link tzw_Balance
    Dim strSQL As String 'Sql查询字符串
    Dim sKmZl As String '科目种类
    Dim iFzhsh As Integer '辅助核算号
    Dim sColStr As String '当前行插入字符串
    Dim nc00 As Double, ncsl00 As Double, ncwb00 As Double        ' 年初数
    Dim Qc As Double, Qcsl As Double, Qcwb As Double        ' 年初数
    Dim LjJ As Double, LjJsl As Double, LjJwb As Double        ' 累计数
    Dim LjD As Double, LjDsl As Double, LjDwb As Double        ' 累计数
    
    InitLoadDataToCll = False
    
    glo.frmProg.ShowProgress 0
    glo.frmProg.Show
    glo.frmProg.SetMsg "正在装载数据，请稍候 ..."
    
    With cllBalance
        strSQL = "SELECT A.kmdm,A.kmmc,kmjc,IsEndKm,kmjc,B.yefx,sldw,wbdw," & _
                    "IsGrwlhs,IsKhwlhs,IsGyswlhs,IsBmhs,IsXmhs," & _
                    "ljj00,ljjsl00,ljjwb00,ljd00,ljdsl00,ljdwb00," & _
                    "ljj" & QcYue & ",ljjsl" & QcYue & ",ljjwb" & QcYue & _
                    ",ljd" & QcYue & ",ljdsl" & QcYue & ",ljdwb" & QcYue & _
                    " FROM tZW_Km" & glo.sOperateYear & " A,tzw_balance" & glo.sOperateYear & " B where A.kmdm=B.kmdm  order by A.kmdm"
        rSt.CursorLocation = adUseClient
        If rSt.State = adStateOpen Then rSt.Close
        rSt.Open strSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
        iRowNum = iFixRows + 1
        If Not rSt.BOF Then rSt.MoveFirst
        iDataRows = rSt.RecordCount '数据行数
        .SetRows iDataRows + iFixRows + 1, 0 '设置总行数
        ReDim arrSlWb(iDataRows + iFixRows)
        ReDim arrKmdm(iDataRows + iFixRows)
        ReDim arrKmmc(iDataRows + iFixRows)
        ReDim arrFx(iDataRows + iFixRows)
        ReDim arrIsEndKM(iDataRows + iFixRows)
        ReDim arrFxStr(iDataRows + iFixRows)
        While Not rSt.EOF
           nc00 = 0: ncsl00 = 0: ncwb00 = 0
           arrKmdm(iRowNum) = Trim$("" & rSt.Fields("kmdm").value)
           arrKmmc(iRowNum) = Trim$("" & rSt.Fields("kmmc").value)
           arrIsEndKM(iRowNum) = Trim$("" & rSt.Fields("IsEndKm").value)
            '(年初金额)  如果方向在借方，则ncfx改为借方 年初金额、年初数量及年初外币分别设为累计借，累计借数量和累计借外币
            If rSt.Fields("yefx").value = "借方" Then
                arrFx(iRowNum) = "借"
                ncsl00 = FormatToDouble("" & rSt.Fields("ljjsl00")) - FormatToDouble(rSt.Fields("ljdsl00"))
                ncwb00 = FormatToDouble("" & rSt.Fields("ljjwb00")) - FormatToDouble(rSt.Fields("ljdwb00"))
                nc00 = FormatToDouble(rSt.Fields("ljj00")) - FormatToDouble(rSt.Fields("ljd00"))
           ElseIf rSt.Fields("yefx").value = "贷方" Then
                arrFx(iRowNum) = "贷"
                ncsl00 = FormatToDouble("" & rSt.Fields("ljdsl00")) - FormatToDouble(rSt.Fields("ljjsl00"))
                ncwb00 = FormatToDouble("" & rSt.Fields("ljdwb00")) - FormatToDouble(rSt.Fields("ljjwb00"))
                nc00 = FormatToDouble("" & rSt.Fields("ljd00")) - FormatToDouble(rSt.Fields("ljj00"))
           End If
           
            ' 若是一月份启用的账务子系统，累计数＝0
            ' 否则  累计数＝表累计数－年初数

           If QcYue = "00" Then
              LjJ = 0: LjJsl = 0: LjJwb = 0: LjD = 0: LjDsl = 0: LjDwb = 0
           Else
              LjJ = Val("" & rSt.Fields("ljj" & QcYue)) - Val("" & rSt.Fields("ljj00"))
              LjJsl = Val("" & rSt.Fields("ljjsl" & QcYue)) - Val("" & rSt.Fields("ljjsl00"))
              LjJwb = Val("" & rSt.Fields("ljjwb" & QcYue)) - Val("" & rSt.Fields("ljjwb00"))
              LjD = Val("" & rSt.Fields("ljd" & QcYue)) - Val("" & rSt.Fields("ljd00"))
              LjDsl = Val("" & rSt.Fields("ljdsl" & QcYue)) - Val("" & rSt.Fields("ljdsl00"))
              LjDwb = Val("" & rSt.Fields("ljdwb" & QcYue)) - Val("" & rSt.Fields("ljdwb00"))
           End If
            ' (期初数) ：  借方  (ljj & QcYue)-(ljd & QcYue)  贷方  (ljd & QcYue)-(ljj & QcYue)
           If QcYue = "00" Then
                Qc = nc00
                Qcsl = ncsl00
                Qcwb = ncwb00
           Else
                If arrFx(iRowNum) = "借" Then
                     Qc = Val("" & rSt.Fields("ljj" & QcYue)) - Val("" & rSt.Fields("ljd" & QcYue))
                     Qcsl = Val("" & rSt.Fields("ljjsl" & QcYue)) - Val("" & rSt.Fields("ljdsl" & QcYue))
                     Qcwb = Val("" & rSt.Fields("ljjwb" & QcYue)) - Val("" & rSt.Fields("ljdwb" & QcYue))
                Else
                     Qc = Val("" & rSt.Fields("ljd" & QcYue)) - Val("" & rSt.Fields("ljj" & QcYue))
                     Qcsl = Val("" & rSt.Fields("ljdsl" & QcYue)) - Val("" & rSt.Fields("ljjsl" & QcYue))
                     Qcwb = Val("" & rSt.Fields("ljdwb" & QcYue)) - Val("" & rSt.Fields("ljjwb" & QcYue))
                End If
           End If
           
           '当前科目种类
           sKmZl = ""
            If Not IsNull(rSt.Fields("sldw")) And rSt.Fields("sldw") <> "" Then
                If Not IsNull(rSt.Fields("wbdw")) And rSt.Fields("wbdw") <> "" Then
                    sKmZl = "slwb": bSlFlag = True: bWbFlag = True
                Else
                    sKmZl = "sl": bSlFlag = True
                End If
            Else
                If Not IsNull(rSt.Fields("wbdw")) And rSt.Fields("wbdw") <> "" Then
                    If Not IsNull(rSt.Fields("sldw")) And rSt.Fields("sldw").value <> "" Then
                        sKmZl = "slwb": bSlFlag = True: bWbFlag = True:
                    Else
                        sKmZl = "wb": bWbFlag = True
                    End If
                End If
            End If
            arrSlWb(iRowNum) = sKmZl
            '得到辅助核算号
            If rSt.Fields("IsGrwlhs") Then
                iFzhsh = 10
            ElseIf rSt.Fields("IsKhwlhs") Then
                If rSt.Fields("IsBmhs") Then
                    iFzhsh = 13
                ElseIf rSt.Fields("IsXmhs") Then
                    iFzhsh = 14
                Else
                    iFzhsh = 1
                End If
            ElseIf rSt.Fields("IsGyswlhs") Then
                If rSt.Fields("IsBmhs") Then
                    iFzhsh = 23
                ElseIf rSt.Fields("IsXmhs") Then
                    iFzhsh = 24
                Else
                    iFzhsh = 2
                End If
            ElseIf rSt.Fields("IsBmhs") Then
                If rSt.Fields("IsXmhs") Then
                    iFzhsh = 34
                Else
                    iFzhsh = 3
                End If
            ElseIf rSt.Fields("IsXmhs") Then
                iFzhsh = 4
            Else
                iFzhsh = 0
            End If
           
           '填充一行数据
           Call pFillCllRow(iRowNum, sKmZl, arrKmdm(iRowNum), arrKmmc(iRowNum), arrFx(iRowNum), ncsl00, ncwb00, nc00, LjJsl, LjJwb, LjJ, LjDsl, LjDwb, LjD, Qcsl, Qcwb, Qc)
           '单元格控制 颜色控制
'           Call pSetRowColor(iRowNum, 1, iFixCols, lFixColColor) ' 固定列颜色
'           Call pSetRowColor(iRowNum, uFxCol.iCol, uFxCol.iCol, lFxColColor) ' 方向列颜色
'           Call pSetRowColor(iRowNum, uQcSlCol.iCol, uQcSlCol.iCol, lQcColColor) ' 期初列颜色
'           Call pSetRowColor(iRowNum, uQcJeCol.iCol, uQcJeCol.iCol, lQcColColor)
'           Call pSetRowColor(iRowNum, uQcWbCol.iCol, uQcWbCol.iCol, lQcColColor)
           If Not arrIsEndKM(iRowNum) Then  '  如果不是末级科目那么该科目就是汇总行
                   Call pSetRowColor(iRowNum, 1, iFixCols + 13, lHzKmColor) '汇总颜色
           Else
                  If GetKmJc(rSt.Fields("kmdm")) > 0 Then
                      Call pSetRowColor(iRowNum, 1, iFixCols + 13, lMxKmColor) '明细颜色
                  End If
           End If
           If Val(iFzhsh) <> 0 Then  ' 辅助核算科目
                   Call pSetRowColor(iRowNum, iFixCols + 2, iFixCols + 10, lFzKmColor) ' 辅助颜色
           End If
           For i = 1 To iFixCols + iDataCols
                Select Case i
                       Case uSlWbLxCol.iCol, uKmdmCol.iCol, uKmmcCol.iCol
                            .SetCellAlign i, iRowNum, 0, 32 + 1 '单元格显示方式水平左对其垂直居中
                            .SetCellNumType i, iRowNum, 0, 0 '默认
                            .SetCellInput i, iRowNum, 0, 5 '只读
                       Case uFxCol.iCol
                            .SetCellAlign i, iRowNum, 0, 32 + 4 '单元格显示方式水平垂直居中
                            .SetCellNumType i, iRowNum, 0, 0 '默认
                            .SetCellInput i, iRowNum, 0, 5 '只读
                       Case uQcWbCol.iCol, uQcJeCol.iCol
                            .SetCellAlign i, iRowNum, 0, 32 + 2 '单元格显示方式水平右对其垂直居中
                            .SetCellDigital i, iRowNum, 0, 2 '小数位数
                            .SetCellInput i, iRowNum, 0, IIf(arrIsEndKM(iRowNum), 2, 5)  '只读
                            .SetCellNumType i, iRowNum, 0, 1 '数值类型
                            .SetCellHideZero i, iRowNum, 0, 1 '为零时不隐藏
                            .SetCellSeparator i, iRowNum, 0, 2 '千分位
'                            .SetCellMinus i, iRowNum, 0, 5 '红色带负号
                       Case uQcSlCol.iCol
                            .SetCellAlign i, iRowNum, 0, 32 + 2 '单元格显示方式水平右对其垂直居中
                            .SetCellDigital i, iRowNum, 0, 3 '小数位数
                            .SetCellInput i, iRowNum, 0, IIf(arrIsEndKM(iRowNum), 2, 5)  '只读
                            .SetCellNumType i, iRowNum, 0, 1 '数值类型
                            .SetCellHideZero i, iRowNum, 0, 1 '为零时不隐藏
                            .SetCellSeparator i, iRowNum, 0, 2 '千分位
'                            .SetCellMinus i, iRowNum, 0, 5 '红色带负号
                    Case uNcSlCol.iCol, uLjDslCol.iCol, uLjJslCol.iCol
                            .SetCellAlign i, iRowNum, 0, 32 + 2 '单元格显示方式水平右对其垂直居中
                            .SetCellDigital i, iRowNum, 0, 3 '小数位数
                            .SetCellNumType i, iRowNum, 0, 1 '数值类型
                            .SetCellHideZero i, iRowNum, 0, 1 '为零时不隐藏
                            .SetCellSeparator i, iRowNum, 0, 2 '千分位
'                            .SetCellMinus i, iRowNum, 0, 5 '红色带负号
                       Case Else
                            .SetCellAlign i, iRowNum, 0, 32 + 2 '单元格显示方式水平右对其垂直居中
                            .SetCellDigital i, iRowNum, 0, 2 '小数位数
                            .SetCellInput i, iRowNum, 0, IIf(arrIsEndKM(iRowNum), 2, 5) '输入数值 是汇总行只读
                            .SetCellNumType i, iRowNum, 0, 1 '数值类型
                            .SetCellHideZero i, iRowNum, 0, 1 '为零时不隐藏
                            .SetCellSeparator i, iRowNum, 0, 2 '千分位
'                            .SetCellMinus i, iRowNum, 0, 5 '红色带负号
                            .SetCellValidChars i, iRowNum, 0, 2 '只允许输入数字和+-
                End Select
           Next
           iRowNum = iRowNum + 1
           rSt.MoveNext
           If iRowNum Mod 10 = 0 Then
              glo.frmProg.ShowProgress iRowNum / (iFixRows + iDataRows) * 100
           End If
        Wend
        .DrawGridLine iFixCols + 2, iFixRows + 1, iFixCols + iDataCols - 2, iFixRows + iDataRows, 0, 2, .FindColorIndex(iDataBgxColor, 1)
    End With
    glo.frmProg.Hide
    Exit Function
Err: InitLoadDataToCll = True
    glo.frmProg.Hide
End Function

'==================控制界面=======================
Private Sub InitGIUControl()
    Shape1.BackColor = lMxKmColor
    Shape2.BackColor = lHzKmColor
    Shape3.BackColor = lFzKmColor
    cllBalance.Visible = True '使cll显示
    lblBeginDate = glo.sOperateYear & "年" & sBeginMonth & "月" '账套期初日期
    PicRO.Visible = bReadOnly '设置标签是否显示
    mnuDetail.Checked = True
    mnuMoney.Checked = True
    tbrZwcs.Buttons("Direct").Enabled = Not bReadOnly '方向
    mnuDirect.Enabled = Not bReadOnly '
    tbrZwcs.Buttons("Save").Enabled = Not bReadOnly '保存
    mnuSave.Enabled = Not bReadOnly '
    tbrZwcs.Buttons("aMount").Enabled = bSlFlag '控制数量按钮
    mnuaMount.Visible = bSlFlag
    tbrZwcs.Buttons("Foring").Enabled = bWbFlag '控制外币按钮
    mnuForing.Visible = bWbFlag
End Sub