frmfi_zznew.frm

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

                                    dTmp = Val(GetMyJFS(CStr(aryvArgu(1)), CStr(aryvArgu(2)), CStr(aryvArgu(3)), "WB", CStr(aryvArgu(4)), CStr(aryvArgu(5))))
                                    dTmp = Format(dTmp, "##0.00")
                                    cllZzNew.SetFuncResult dTmp, "", 0
                    End Select
              
              Case Else
                   Exit Sub
       End Select
       
End Sub

Private Sub form_load()
    cllZzNew.Login "南京伊康计算机工程公司", "11010504", "0060-1733-7722-3004"
    Call AddUserDefineFunction
    Call InitHead
    Call FillMfg
End Sub

'用于 Cell 控件，
'将本软件提供的所有自定义函数添加到指定的 Cell 控件
Public Sub AddUserDefineFunction()
   Dim sTmp As String
   Dim lCount As Long
    
    With cllZzNew
            sTmp = """伊康财务v6系列_ZW"" double QC ( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double QC ( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "期初余额"
            sTmp = sTmp & vbCrLf & "END_HELP"
            lCount = .DefineFunctions(sTmp)
            
            sTmp = """伊康财务v6系列_ZW""  double QM( string d1,string d2,string d3,string d4],string d5] ) "
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double QM( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "期末余额"
            sTmp = sTmp & vbCrLf & "END_HELP"
             lCount = .DefineFunctions(sTmp)
                                    
            sTmp = """伊康财务v6系列_ZW""  double FS (  string d1 ,string d2 ,string d3,string d4],string d5]  )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double FS ( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "发生额"
            sTmp = sTmp & vbCrLf & "END_HELP"
            lCount = .DefineFunctions(sTmp)
                                    
            sTmp = """伊康财务v6系列_ZW""  double LFS( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double LFS( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "累计发生额"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp
            
            '-----------------------------------------------------------------------
            'ADD贷方合计，借方合计  卞 2002/04/12
            '--------------BEGIN----------------------------------------------------
            
            sTmp = """伊康财务v6系列_ZW""  double DFHJ( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double DFHJ( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "贷方合计"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp
            
            sTmp = """伊康财务v6系列_ZW""  double JFHJ( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double JFHJ( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "借方合计"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp
            
            '--------------END--------------------------------------------------
                      
            sTmp = """伊康财务v6系列_ZW""  double JFS( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double JFS( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "净发生额"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp

         '------------------------------------------------------------------------------
            sTmp = """伊康财务v6系列_ZW""  double QCN( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double QCN( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "期初数量"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp
            
            sTmp = """伊康财务v6系列_ZW""  double QMN( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double QMN( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "期末数量"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp
                                    
            sTmp = """伊康财务v6系列_ZW""  double FSN( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double FSN( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "发生数量"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp

            sTmp = """伊康财务v6系列_ZW""  double LFSN( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double LFSN( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "累计发生数量"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp

            sTmp = """伊康财务v6系列_ZW""  double JFSN( string d1,string d2,string d3,string d4],string d5])"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double JFSN( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "净发生数量"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp
            
            sTmp = """伊康财务v6系列_ZW""  double QCW( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double QCW( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "期初外币"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp
            
            sTmp = """伊康财务v6系列_ZW""  double QMW( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double QMW( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "期末外币"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp

            sTmp = """伊康财务v6系列_ZW""  double FSW( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double FSW(string d1,string d2,string d3,string d4],string d5])"
            sTmp = sTmp & vbCrLf & "发生外币"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp

            sTmp = """伊康财务v6系列_ZW""  double LFSW(  string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double LFSW( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "累计发生外币"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp

            sTmp = """伊康财务v6系列_ZW""  double JFSW( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double JFSW( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "净发生外币"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp

    End With
End Sub


Private Function CheckIsCZ(newTable As String, newZD As String, ByVal newVal As String) As Boolean        '是否存在
    Dim rstTmp As New ADODB.Recordset
    rstTmp.CursorLocation = adUseClient
    rstTmp.Open "select * from " & newTable & " where " & newZD & "='" & newVal & "'", glo.cnnMain, adOpenStatic, adLockReadOnly
    
    If Not (rstTmp.EOF And rstTmp.BOF) Then
        CheckIsCZ = True
    Else
        CheckIsCZ = False
    End If
End Function

'   自定义取数函数
Private Function GetMyQC(ByVal sKm As String, ByVal sQj As String, ByVal sFx As String, ByVal sFlag As String, ByVal sBm As String, ByVal sXm As String)  '取期初 KM,QJ,FS
    Dim rstTmp As New ADODB.Recordset
    Dim sPreMonth As String     '保存上一月份
    Dim sMonth As String
    Dim sTableName As String
    Dim sWhere As String
    
    If Trim$(sBm + sXm) = "" Then
        sTableName = "tZW_Balance"
        sWhere = "kmdm='" & sKm & "'"
    Else
        sTableName = "tUSU_Fz"
        sWhere = "kmdm like '" & sKm & "%'"
        If Trim$(sXm) <> "" Then
            sXm = "↑" + sXm
            sWhere = sWhere + " and xmdm like '%" + sXm + "%'"
        End If
        If Trim$(sBm) <> "" Then
            sWhere = sWhere + " and bmdm like '" + sBm + "%'"
        End If
    End If
    sMonth = Format(sKJRQ, "mm")
    

'====================================2002.9.11 yao revise===========================================================
    GetMyQC = 0
    If sQj = "月" Then          '按月取数
       If sFx = "借" Then       '按借
            If sMonth = "01" Then  '当为一月份时，取年初余额借
               rstTmp.Open "select sum(ljj" & Trim(sFlag) & "00) from " + sTableName & glo.sOperateYear & " where " & _
               sWhere, glo.cnnMain, adOpenStatic, adLockReadOnly
               If Not IsNull(rstTmp.Fields(0).value) Then
                    GetMyQC = rstTmp.Fields(0).value
               End If
                Exit Function
            Else
               sPreMonth = Format(yfdel(sKJRQ), "mm")       '否则期初余额＝年初余额＋上月累计借－上月累计贷
               rstTmp.Open "select sum(ljj" & Trim(sFlag) & "00+ljj" & Trim(sFlag) & sPreMonth & "-ljd" & Trim(sFlag) & sPreMonth & ") from " + sTableName & glo.sOperateYear & _
               " where " + sWhere, glo.cnnMain, adOpenStatic, adLockReadOnly
               If Not IsNull(rstTmp.Fields(0).value) Then
                    GetMyQC = rstTmp.Fields(0).value
               End If
               Exit Function
               
            End If
       End If
       
       If sFx = "贷" Then
           If sMonth = "01" Then  '当为一月份时，取年初余额贷
               rstTmp.Open "select sum(ljd" & Trim(sFlag) & "00) from " + sTableName & glo.sOperateYear & " where " & _
               sWhere, glo.cnnMain, adOpenStatic, adLockReadOnly
               If Not IsNull(rstTmp.Fields(0).value) Then
                    GetMyQC = rstTmp.Fields(0).value
               End If
                Exit Function
            Else
               sPreMonth = Format(yfdel(sKJRQ), "mm")       '否则期初余额＝年初余额＋上月累计贷－上月累计借
               rstTmp.Open "select sum(ljd" & Trim(sFlag) & "00+ljd" & Trim(sFlag) & sPreMonth & "-ljj" & Trim(sFlag) & sPreMonth & ") from " + sTableName & glo.sOperateYear & _
               " where " + sWhere, glo.cnnMain, adOpenStatic, adLockReadOnly
               If Not IsNull(rstTmp.Fields(0).value) Then
                    GetMyQC = rstTmp.Fields(0).value
               End If
               Exit Function
            End If
       End If
    End If
    
    '--------------------------按取年
    If sQj = "年" Then
       If sFx = "借" Then       '按借
               rstTmp.Open "select sum(ljj" & Trim(sFlag) & "00) from " + sTableName & glo.sOperateYear & " where " & _
               sWhere, glo.cnnMain, adOpenStatic, adLockReadOnly
               If Not IsNull(rstTmp.Fields(0).value) Then
                    GetMyQC = rstTmp.Fields(0).value
               End If
                Exit Function
       End If
       
       If sFx = "贷" Then
            rstTmp.Open "select sum(ljd" & Trim(sFlag) & "00) from " + sTableName & glo.sOperateYear & " where " & _
            sWhere, glo.cnnMain, adOpenStatic, adLockReadOnly
            If Not IsNull(rstTmp.Fields(0).value) Then
                 GetMyQC = rstTmp.Fields(0).value
            End If
             Exit Function
       End If
   End If
 '========================================================================================================
End Function
Private Function GetMyQM(ByVal sKm As String, ByVal sQj As String, ByVal sFx As String, sFlag As String, ByVal sBm As String, ByVal sXm As String) As Double    '取期末
    Dim rstTmp As New ADODB.Recordset
    Dim sMonth As String
    Dim sTableName As String
    Dim sWhere As String
    
    If Trim$(sBm + sXm) = "" Then
        sTableName = "tZW_Balance"
        sWhere = "kmdm='" & sKm & "'"
    Else
        sTableName = "tUSU_Fz"
        sWhere = "kmdm like '" & sKm & "%'"
        If Trim$(sXm) <> "" Then
            sXm = "↑" + sXm
            sWhere = sWhere + " and xmdm like '%" + sXm + "%'"
        End If
        If Trim$(sBm) <> "" Then
            sWhere = sWhere + " and bmdm like '" + sBm + "%'"
        End If
    End If
    
    GetMyQM = 0
    If sQj = "月" Then          '按月取数
        sMonth = Format(sKJRQ, "mm")
    Else
        sMonth = "12"          '当按年时：取１２月份为年末数
    End If
    
       If sFx = "借" Then       '按借
                              '期末余额借＝年初余额＋本月累计借－本月累计贷
            rstTmp.Open "select sum(ljj" & Trim(sFlag) & "00+ljj" & Trim(sFlag) & sMonth & "-ljd" & Trim(sFlag) & sMonth & ") from " + sTableName & glo.sOperateYear & _
            " where " + sWhere, glo.cnnMain, adOpenStatic, adLockReadOnly
            If rstTmp.EOF Then Exit Function
            If Not IsNull(rstTmp.Fields(0).value) Then
                  GetMyQM = rstTmp.Fields(0).value
            End If
            Exit Function
      End If
      
      If sFx = "贷" Then
                                 '期末余额贷＝年初余额＋本月累计借－本月累计贷
            rstTmp.Open "select sum(ljd" & Trim(sFlag) & "00+ljd" & Trim(sFlag) & sMonth & "-ljj" & Trim(sFlag) & sMonth & ") from " + sTableName & glo.sOperateYear & _
            " where " + sWhere, glo.cnnMain, adOpenStatic, adLockReadOnly
            If rstTmp.EOF = False Then
                If Not IsNull(rstTmp.Fields(0).value) Then
                     GetMyQM = rstTmp.Fields(0).value
                End If
            End If
            Exit Function
      End If
        
End Function
Private Function GetMyFS(ByVal sKm As String, ByVal sQj As String, ByVal sFx As String, sFlag As String, ByVal sBm As String, ByVal sXm As String) As Double     '取发生
    Dim rstTmp As New ADODB.Recordset
    Dim sPreMonth As String     '保存上一月份
    Dim sMonth As String
    
    Dim sTableName As String
    Dim sWhere As String
    
    If Trim$(sBm + sXm) = "" Then
        sTableName = "tZW_Balance"
        sWhere = "kmdm='" & sKm & "'"
    Else
        sTableName = "tUSU_Fz"
        sWhere = "kmdm like '" & sKm & "%'"
        If Trim$(sXm) <> "" Then
            sXm = "↑" + sXm
            sWhere = sWhere + " and xmdm like '%" + sXm + "%'"
        End If
        If Trim$(sBm) <> "" Then