billpublic.bas

金算盘软件代码

    blnOther.blnIsCustomer = False
    blnOther.blnIsDepartment = False
    blnOther.blnIsDetail = False
    blnOther.blnIsEmployee = False
    blnOther.blnIsJob = False
    blnOther.blnIsMultiCurrency = False
    blnOther.blnIsQuantity = False
    blnOther.blnDefault = True
    blnOther.lngAccountID = 0
    blnOther.strAccountCode = ""
    blnOther.strAccountName = ""
    blnOther.strAccountFullName = ""
    blnOther.intAccountNatureID = 0
    blnOther.strQuantityUnit = ""
    blnOther.blnIsCash = False
    blnOther.blnIsProject = False
    If lngAccountID <= 0 Then Exit Function
    strSQL = "SELECT * FROM Account WHERE lngAccountID=" & lngAccountID
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenForwardOnly)
    If recTmp Is Nothing Then Exit Function
    If (recTmp.BOF And recTmp.EOF) Then GoTo EndProc
'设置标志值
    With recTmp
        blnOther.blnIsInActive = (!blnIsInActive <> 0)
        blnOther.blnIsAllCurrency = (!blnIsAllCurrency <> 0)
        blnOther.blnIsClass1 = (!blnIsClass1 <> 0)
        blnOther.blnIsClass2 = (!blnIsClass2 <> 0)
        blnOther.blnIsCustomer = (!blnIsCustomer <> 0)
        blnOther.blnIsDepartment = (!blnIsDepartment <> 0)
        blnOther.blnIsDetail = (!blnIsDetail <> 0)
        blnOther.blnIsEmployee = (!blnIsEmployee <> 0)
        blnOther.blnIsJob = False
        blnOther.blnIsMultiCurrency = (!blnIsMultCurrency <> 0)
        blnOther.blnIsQuantity = (!blnIsQuantity <> 0)
        blnOther.lngAccountID = lngAccountID
        blnOther.strAccountCode = !strAccountCode
        blnOther.strAccountName = !strAccountName
        blnOther.strAccountFullName = !strFullName
        blnOther.intAccountNatureID = !lngAccountNatureID
        blnOther.strQuantityUnit = !strQuantityUnit
        blnOther.blnIsCash = (!blnIsCash <> 0)
    End With
 '设置默认的标志
    If blnOther.blnIsInActive Or blnOther.blnIsAllCurrency _
        Or blnOther.blnIsClass1 Or blnOther.blnIsClass2 Or blnOther.blnIsCustomer Or blnOther.blnIsDepartment _
        Or blnOther.blnIsEmployee Or blnOther.blnIsJob Or blnOther.blnIsMultiCurrency _
        Or blnOther.blnIsQuantity Then
            blnOther.blnDefault = False
    End If
   If gclsBase.Trade = "邮电通信" Then
'        strSql = "SELECT lngProjectID FROM Project WHERE blnIsInActive=0 AND lngAccountID=" & lngAccountID
'        Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
'        If recTmp Is Nothing Then GoTo EndProc
'        If (recTmp.BOF And recTmp.EOF) Then
'              blnOther.blnIsProject = False
'        Else
'              blnOther.blnIsProject = True
'        End If
        blnOther.blnIsProject = True
   End If
EndProc:
    If Not recTmp Is Nothing Then
        recTmp.Close
        Set recTmp = Nothing
    End If
    
End Function
Public Function strGetMaxNO(ByVal intY As Integer, _
                            ByVal bytP As Byte, _
                            ByVal lngTypeID As Long, _
                            ByVal strAlpha As String, _
                            Optional ByVal strDate As String = "", _
                            Optional ByVal MinNo As Long = 0, _
                            Optional ByVal MaxNo As Long = 9999) As String

'取最大编号(原最大单据号+1)
'最大编号自动加一后存回
'-----单据新增时应调用本函数(由strGetNo函数调用)
'入口参数:
'         会计年度
'         会计期间
'         单据类型ID
'         单据编号字母部分
'返回值:
'         当前最大单据编号数字部分+1
    Dim recMaxNo As rdoResultset
    Dim strCriteria As String
    Dim strNewMaxNo As String
    Dim strSQL As String
    '编号序时Start---------------------------------------------
    If gclsBase.NoOrder = True And strDate <> "" Then
        Dim recTmp As rdoResultset
        Dim lngMaxNo As Long '下一天的最小号-1
        Dim lngMinNo As Long '上一天的最大号+1
        If lngTypeID = 41 Or lngTypeID = 54 Or lngTypeID = 55 Then '记帐凭证
            strSQL = "SELECT Min(intVoucherNo) FROM Voucher WHERE intYear=" & intY & " AND bytPeriod=" & bytP & " AND lngVoucherTypeID=" & C2lng(strAlpha) & _
                    " AND strDate>'" & strDate & "'"
        ElseIf lngTypeID >= 34 And lngTypeID <= 40 Then '应收/应付、现金银行
            strSQL = "SELECT Min(lngReceiptNO) FROM Activity WHERE intYear=" & intY & " AND bytPeriod=" & bytP & " AND lngReceiptTypeID=" & lngTypeID & " AND strReceiptNO='" & IIf(strAlpha = "", " ", strAlpha) & "'" & _
                    " AND strDate>'" & strDate & "'"
        ElseIf lngTypeID >= 2 And lngTypeID <= 11 Or lngTypeID >= 13 And lngTypeID <= 24 Or lngTypeID = 26 Or lngTypeID >= 28 And lngTypeID <= 31 Or lngTypeID >= 42 And lngTypeID <= 47 Or lngTypeID = 52 Then
            strSQL = "SELECT Min(lngReceiptNO) FROM ItemActivity WHERE intYear=" & intY & " AND bytPeriod=" & bytP & " AND lngReceiptTypeID=" & lngTypeID & " AND strReceiptNO='" & IIf(strAlpha = "", " ", strAlpha) & "'" & _
                    " AND strDate>'" & strDate & "'"
        ElseIf lngTypeID = 1 Then   '采购订单
            strSQL = "SELECT Min(lngReceiptNO) FROM PurchaseOrder WHERE intYear=" & intY & " AND bytPeriod=" & bytP & " AND lngReceiptTypeID=" & lngTypeID & " AND strReceiptNO='" & IIf(strAlpha = "", " ", strAlpha) & "'" & _
                    " AND strDate>'" & strDate & "'"
        ElseIf lngTypeID = 12 Then  '销售订单
            strSQL = "SELECT Min(lngReceiptNO) FROM SaleOrder WHERE intYear=" & intY & " AND bytPeriod=" & bytP & " AND lngReceiptTypeID=" & lngTypeID & " AND strReceiptNO='" & IIf(strAlpha = "", " ", strAlpha) & "'" & _
                    " AND strDate>'" & strDate & "'"
        ElseIf lngTypeID = 32 Then  '入库成本
            strSQL = "SELECT Min(lngReceiptNO) FROM CostPrice WHERE intYear=" & intY & " AND bytPeriod=" & bytP & " AND lngReceiptTypeID=" & lngTypeID & " AND strReceiptNO='" & IIf(strAlpha = "", " ", strAlpha) & "'" & _
                    " AND strDate>'" & strDate & "'"
        ElseIf lngTypeID = 33 Then  '商品盘点
            strSQL = "SELECT Min(lngReceiptNO) FROM StockTaking WHERE intYear=" & intY & " AND bytPeriod=" & bytP & " AND lngReceiptTypeID=" & lngTypeID & " AND strReceiptNO='" & IIf(strAlpha = "", " ", strAlpha) & "'" & _
                    " AND strDate>'" & strDate & "'"
        Else
            GoTo OldBegin
        End If
        Set recTmp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenForwardOnly)
        If recTmp.EOF Then
            lngMaxNo = 0
        ElseIf IsNull(recTmp(0)) Then
            lngMaxNo = 0
        ElseIf recTmp(0) = 0 Then
            lngMaxNo = 0
        Else
            lngMaxNo = recTmp(0) - 1
        End If
        recTmp.Close
        Set recTmp = Nothing
        
        If lngMaxNo > MaxNo - 1 Then
            lngMaxNo = MaxNo - 1
        End If
        If lngMaxNo > 0 Then
            If lngTypeID = 41 Or lngTypeID = 54 Or lngTypeID = 55 Then '记帐凭证
                strSQL = "SELECT MAX(intVoucherNo) FROM Voucher WHERE intYear=" & intY & " AND bytPeriod=" & bytP & " AND lngVoucherTypeID=" & C2lng(strAlpha) & _
                        " AND strDate<'" & strDate & "'"
            ElseIf lngTypeID >= 34 And lngTypeID <= 40 Then '应收/应付、现金银行
                strSQL = "SELECT MAX(lngReceiptNO) FROM Activity WHERE intYear=" & intY & " AND bytPeriod=" & bytP & " AND lngReceiptTypeID=" & lngTypeID & " AND strReceiptNO='" & IIf(strAlpha = "", " ", strAlpha) & "'" & _
                        " AND strDate<'" & strDate & "'"
            ElseIf lngTypeID >= 2 And lngTypeID <= 11 Or lngTypeID >= 13 And lngTypeID <= 24 Or lngTypeID = 26 Or lngTypeID >= 28 And lngTypeID <= 31 Or lngTypeID >= 42 And lngTypeID <= 47 Or lngTypeID = 52 Then
                strSQL = "SELECT Max(lngReceiptNO) FROM ItemActivity WHERE intYear=" & intY & " AND bytPeriod=" & bytP & " AND lngReceiptTypeID=" & lngTypeID & " AND strReceiptNO='" & IIf(strAlpha = "", " ", strAlpha) & "'" & _
                        " AND strDate<'" & strDate & "'"
            ElseIf lngTypeID = 1 Then   '采购订单
                strSQL = "SELECT Max(lngReceiptNO) FROM PurchaseOrder WHERE intYear=" & intY & " AND bytPeriod=" & bytP & " AND lngReceiptTypeID=" & lngTypeID & " AND strReceiptNO='" & IIf(strAlpha = "", " ", strAlpha) & "'" & _
                        " AND strDate<'" & strDate & "'"
            ElseIf lngTypeID = 12 Then  '销售订单
                strSQL = "SELECT Max(lngReceiptNO) FROM SaleOrder WHERE intYear=" & intY & " AND bytPeriod=" & bytP & " AND lngReceiptTypeID=" & lngTypeID & " AND strReceiptNO='" & IIf(strAlpha = "", " ", strAlpha) & "'" & _
                        " AND strDate<'" & strDate & "'"
            ElseIf lngTypeID = 32 Then  '入库成本
                strSQL = "SELECT Max(lngReceiptNO) FROM CostPrice WHERE intYear=" & intY & " AND bytPeriod=" & bytP & " AND lngReceiptTypeID=" & lngTypeID & " AND strReceiptNO='" & IIf(strAlpha = "", " ", strAlpha) & "'" & _
                        " AND strDate<'" & strDate & "'"
            ElseIf lngTypeID = 33 Then  '商品盘点
                strSQL = "SELECT Max(lngReceiptNO) FROM StockTaking WHERE intYear=" & intY & " AND bytPeriod=" & bytP & " AND lngReceiptTypeID=" & lngTypeID & " AND strReceiptNO='" & IIf(strAlpha = "", " ", strAlpha) & "'" & _
                        " AND strDate<'" & strDate & "'"
            Else
            End If
            Set recTmp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenForwardOnly)
            If recTmp.EOF Then
                lngMinNo = 1
            ElseIf IsNull(recTmp(0)) Then
                lngMinNo = 1
            ElseIf recTmp(0) = 0 Then
                lngMinNo = 1
            Else
                lngMinNo = recTmp(0) + 1
            End If
            recTmp.Close
            Set recTmp = Nothing
            
            If lngMinNo < MinNo + 1 Then
                lngMinNo = MinNo + 1
            End If
            
            If lngMaxNo >= lngMinNo Then
                If lngTypeID = 41 Or lngTypeID = 54 Or lngTypeID = 55 Then '记帐凭证
                    strSQL = "SELECT intVoucherNo FROM Voucher WHERE intYear=" & intY & " AND bytPeriod=" & bytP & " AND lngVoucherTypeID=" & C2lng(strAlpha) & _
                            " AND strDate='" & strDate & "'" & " ORDER BY intVoucherNo"
                ElseIf lngTypeID >= 34 And lngTypeID <= 40 Then '应收/应付、现金银行
                    strSQL = "SELECT lngReceiptNO FROM Activity WHERE intYear=" & intY & " AND bytPeriod=" & bytP & " AND lngReceiptTypeID=" & lngTypeID & " AND strReceiptNO='" & IIf(strAlpha = "", " ", strAlpha) & "'" & _
                            " AND strDate='" & strDate & "'" & " ORDER BY lngReceiptNO"
                ElseIf lngTypeID >= 2 And lngTypeID <= 11 Or lngTypeID >= 13 And lngTypeID <= 24 Or lngTypeID = 26 Or lngTypeID >= 28 And lngTypeID <= 31 Or lngTypeID >= 42 And lngTypeID <= 47 Or lngTypeID = 52 Then
                    strSQL = "SELECT lngReceiptNO FROM ItemActivity WHERE intYear=" & intY & " AND bytPeriod=" & bytP & " AND lngReceiptTypeID=" & lngTypeID & " AND strReceiptNO='" & IIf(strAlpha = "", " ", strAlpha) & "'" & _
                            " AND strDate='" & strDate & "'" & " ORDER BY lngReceiptNO"
                ElseIf lngTypeID = 1 Then   '采购订单
                    strSQL = "SELECT lngReceiptNO FROM PurchaseOrder WHERE intYear=" & intY & " AND bytPeriod=" & bytP & " AND lngReceiptTypeID=" & lngTypeID & " AND strReceiptNO='" & IIf(strAlpha = "", " ", strAlpha) & "'" & _
                            " AND strDate='" & strDate & "'" & " ORDER BY lngReceiptNO"
                ElseIf lngTypeID = 12 Then  '销售订单
                    strSQL = "SELECT lngReceiptNO FROM SaleOrder WHERE intYear=" & intY & " AND bytPeriod=" & bytP & " AND lngReceiptTypeID=" & lngTypeID & " AND strReceiptNO='" & IIf(strAlpha = "", " ", strAlpha) & "'" & _
                            " AND strDate='" & strDate & "'" & " ORDER BY lngReceiptNO"
                ElseIf lngTypeID = 32 Then  '入库成本
                    strSQL = "SELECT lngReceiptNO FROM CostPrice WHERE intYear=" & intY & " AND bytPeriod=" & bytP & " AND lngReceiptTypeID=" & lngTypeID & " AND strReceiptNO='" & IIf(strAlpha = "", " ", strAlpha) & "'" & _
                            " AND strDate='" & strDate & "'" & " ORDER BY lngReceiptNO"
                ElseIf lngTypeID = 33 Then  '商品盘点
                    strSQL = "SELECT lngReceiptNO FROM StockTaking WHERE intYear=" & intY & " AND bytPeriod=" & bytP & " AND lngReceiptTypeID=" & lngTypeID & " AND strReceiptNO='" & IIf(strAlpha = "", " ", strAlpha) & "'" & _
                            " AND strDate='" & strDate & "'" & " ORDER BY lngReceiptNO"
                Else
                End If
                Set recTmp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenForwardOnly)
                If recTmp.EOF Then
                Else
                    Do While recTmp.EOF = False
                        If recTmp(0) > lngMinNo Then Exit Do
                        If lngMinNo <= recTmp(0) Then lngMinNo = recTmp(0) + 1
                        If lngMinNo > lngMaxNo Then Exit Do
                        recTmp.MoveNext
                    Loop
                End If
                recTmp.Close
                Set recTmp = Nothing
                If lngMaxNo >= lngMinNo Then
                    strNewMaxNo = Format$(lngMinNo, "0000")
                    strGetMaxNO = strAlpha & strNewMaxNo
                    Exit Function
                End If
            End If
        End If
    End If
    '编号序时End-------------------------------------------------
OldBegin:
    On Error GoTo ErrorHandler
        If strAlpha = "" Then
            strAlpha = " "
        End If
        strGetMaxNO = ""
        strCriteria = "intYear=" & intY & _
                 " and bytPeriod=" & bytP & _
                 " and lngReceiptTypeID=" & lngTypeID & _
                 " and ' '||Ltrim(strReceiptNO)='" & " " & LTrim(strAlpha) & "'"
ReOpen:
        If Not recMaxNo Is Nothing Then
            Set recMaxNo = Nothing
        End If
        Set recMaxNo = gclsBase.BaseDB.OpenResultset("SELECT * FROM ReceiptMaxNo WHERE " & strCriteria, _
                rdOpenDynamic, rdConcurValues)
        If recMaxNo Is Nothing Then
            Exit Function
        End If
        If Not recMaxNo.Updatable Then
            MsgBox "最大编号表不能修改!)"
            recMaxNo.Close
            Set recMaxNo = Nothing
            Exit Function
        End If
        With recMaxNo
            If (.BOF And .EOF) Then
                strNewMaxNo = "0001"
'                strSql = "INSERT INTO ReceiptMaxNo VALUES(" & intY & "," & _
'                    bytP & "," & lngTypeID & ",'" & strAlpha & "',1) "
'                gclsBase.BaseDB.Execute strSql
                .AddNew
                    !intYear = intY
                    !bytPeriod = bytP
                    !lngReceiptTypeID = lngTypeID
                    !strReceiptNo = strAlpha
                    !lngReceiptNo = 1
                .Update
            Else
                If !lngReceiptNo >= 9999 Then
                  strNewMaxNo = "0000"
                Else
                      strNewMaxNo = Format(!lngReceiptNo + 1, "0000")
                      If gclsBase.AutoNo = False Then
                        .Edit