maketrans.cls

金算盘软件代码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "MakeTrans"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

''''''''''''''''''''''''''
'
'   通用转帐类
'
'   魏然 1998.11.1
'
''''''''''''''''''''''''''

Private mclsBaseFun As BaseFunction

Private mlngAccountID() As Long
Private mlngCustomerID() As Long
Private mlngDepartmentID() As Long
Private mlngEmployeeID() As Long
Private mlngJobID() As Long
Private mlngClassID1() As Long
Private mlngClassID2() As Long
Private mintDirection() As Integer
Private mdblAmount() As Double
Private mdblCurrencyAmount() As Double
Private mdblQuantity() As Double
Private mlngTransID() As Long
Private mlngTypeID() As Long
Private mlngTemplateID() As Long
Private mintNum() As Integer
Private mlngCurrencyID() As Long
Private mstrRemark() As String
Private mintSub As Integer
Private mintCount As Integer

Public Property Get AccountID(ByVal Index As Integer) As Long
   AccountID = mlngAccountID(Index)
End Property

Public Property Get CustomerID(ByVal Index As Integer) As Long
   CustomerID = mlngCustomerID(Index)
End Property

Public Property Get DepartmentID(ByVal Index As Integer) As Long
   DepartmentID = mlngDepartmentID(Index)
End Property

Public Property Get EmployeeID(ByVal Index As Integer) As Long
   EmployeeID = mlngEmployeeID(Index)
End Property

Public Property Get JobID(ByVal Index As Integer) As Long
   JobID = mlngJobID(Index)
End Property

Public Property Get ClassID1(ByVal Index As Integer) As Long
   ClassID1 = mlngClassID1(Index)
End Property

Public Property Get ClassID2(ByVal Index As Integer) As Long
   ClassID2 = mlngClassID2(Index)
End Property

Public Property Get Direction(ByVal Index As Integer) As Integer
   Direction = mintDirection(Index)
End Property

Public Property Get Amount(ByVal Index As Integer) As Double
   Amount = mdblAmount(Index)
End Property

Public Property Get CurrencyAmount(ByVal Index As Integer) As Double
   CurrencyAmount = mdblCurrencyAmount(Index)
End Property

Public Property Get Quantity(ByVal Index As Integer) As Double
   Quantity = mdblQuantity(Index)
End Property

Public Property Get TransID(ByVal Index As Integer) As Long
   TransID = mlngTransID(Index)
End Property

'凭证类型ID
Public Property Get TypeID(ByVal Index As Integer) As Long
   TypeID = mlngTypeID(Index)
End Property

Public Property Get TemplateID(ByVal Index As Integer) As Long
   TemplateID = mlngTemplateID(Index)
End Property

'附单数
Public Property Get Num(ByVal Index As Integer) As Integer
   Num = mintNum(Index)
End Property

Public Property Get CurrencyID(ByVal Index As Integer) As Long
   CurrencyID = mlngCurrencyID(Index)
End Property

Public Property Get Remark(ByVal Index As Integer) As String
   Remark = mstrRemark(Index)
End Property

'分录数
Public Property Get Subs() As Integer
   Subs = mintSub
End Property

'转帐（实现）
'lngTransVoucherID：转帐模版ID
Public Function TransVoucher(lngTransVoucherID As Long) As Boolean
    Dim strSql As String
    Dim arrAccount(7) As Boolean '会计科目具有的核算项目
    Dim lngTransVoucherDetailID As Long
    Dim strAccountId As String
    
    '当科目为末级科目时，可以设置核算项目条件
    Dim lngCustomerID_MJ As Long
    Dim lngDepartmentID_MJ As Long
    Dim lngEmployeeID_MJ As Long
    Dim lngJobID_MJ As Long
    Dim lngClassID1_MJ As Long
    Dim lngClassID2_MJ As Long
    Dim lngCurNow As Long
    Dim intDirection As Integer
    Dim recTemp_Trans As rdoResultset
    Dim recTemp_Account As rdoResultset
    
    Dim strFunc As String
    Dim strCurrFunc As String
    Dim strQuanFunc As String
   
    mintCount = 0
    '获得本条转帐模板的所有转出科目
    strSql = "SELECT TransVoucherDetail.* From TransVoucherDetail WHERE (((TransVoucherDetail.lngTransVoucherID)=" & lngTransVoucherID & ") AND ((TransVoucherDetail.intTransDirection)=-1))"
    Set recTemp_Trans = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTemp_Trans.BOF And recTemp_Trans.EOF Then Exit Function
    recTemp_Trans.MoveFirst
    Do While Not recTemp_Trans.EOF
        lngTransVoucherDetailID = recTemp_Trans(0)

        '找到本转出科目下面的所有末级科目(如果本科目为末级科目，则返回的记录集仅包括本科目)
        strSql = "SELECT strAccountCode FROM Account WHERE lngAccountID= " & recTemp_Trans("lngAccountID")
        Set recTemp_Account = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If recTemp_Account.EOF Then
           Exit Function
        Else
           strAccountCode = recTemp_Account!strAccountCode
        End If
        
        Set recTemp_Account = Nothing
        strSql = "SELECT * FROM Account WHERE blnIsDetail=1 And (strAccountCode='" & strAccountCode & "' Or strAccountCode Like '" & strAccountCode & "-%') Order By strAccountCode"
        Set recTemp_Account = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If recTemp_Account.BOF And recTemp_Account.EOF Then Exit Function

        recTemp_Account.MoveFirst
        Do While Not recTemp_Account.EOF

            
            '1) 科目的具有的核算项目
            With recTemp_Account
                arrAccount(1) = !blnIsCustomer
                arrAccount(2) = !blnIsDepartment
                arrAccount(3) = !blnIsEmployee
                '''arrAccount(4) = !blnIsJob
                arrAccount(5) = !blnIsClass1
                arrAccount(6) = !blnIsClass2
            End With

            strAccountId = recTemp_Account(0)
            '说明：当科目为末级时，如果科目有某项核算项目，则可能设置该核算项的计算条件