-

VB开发的ERP系统

                dblLow = .Fields("LowStorage")
                dblNow = .Fields("NowStorage")
            Else
                If IsNull(.Fields("HighQuan")) And IsNull(.Fields("LowQuan")) And IsNull(.Fields("EndQuan")) Then
                    RecTemp.Close
                    Set RecTemp = Nothing
                    Exit Function
                Else
                    dblHigh = .Fields("HighQuan")
                    dblLow = .Fields("LowQuan")
                    dblNow = .Fields("EndQuan")
                End If
            End If
        Else
            RecTemp.Close
            Set RecTemp = Nothing
            Exit Function
        End If
    End With
    
    RecTemp.Close
    Set RecTemp = Nothing

    If InOutFlag = 1 Then
        If dblHigh <> 0 Then
            If dblNow + dblEndQuan > dblHigh Then
                Tsxx = "库存超储,请检查库存量!"
                Call Xtxxts(Tsxx, 0, 1)
                Exit Function
            End If
        End If
        If dblLow <> 0 Then
            If dblNow + dblEndQuan < dblLow Then
                Tsxx = "库存低储,请检查库存量!"
                Call Xtxxts(Tsxx, 0, 1)
                Exit Function
            End If
        End If
    Else
        If dblHigh <> 0 Then
            If dblNow + tempQuan - dblEndQuan > dblHigh Then
                Tsxx = "库存超储,请检查库存量!"
                Call Xtxxts(Tsxx, 0, 1)
                Exit Function
            End If
        End If
        If dblLow <> 0 Then
            If dblNow + tempQuan - dblEndQuan < dblLow Then
                Tsxx = "库存低储,请检查库存量!"
                Call Xtxxts(Tsxx, 0, 1)
                Exit Function
            End If
        End If
    End If
    
End Function
Public Function BatchJudge(strWhCode As String, strMNum As String, strBatch As String, intCount As Integer, intFatherID() As Integer, intChildID() As Integer, IsQc() As Boolean, flag As Boolean) As Integer
'函数功能：判断批次是否存在，如果存在其所对应的纪录
'输入参数：strWhCode------仓库编码          strMNum---------物料编码            strBatch---------批号
'          Flag ----------新增和删除标志（True表示删除）
'返 回 值：BatchJudge=1---批号不存在        intCount--------符合条件的记录个数
'          intFatherID()--符合条件的主表ID  intChildID------符合条件的子表ID

    Dim RecTemp As New ADODB.Recordset
    Dim Sqlstr As String
    Dim tempJsq As Integer

    If flag = True Then
        Sqlstr = "Select * FROM  kf_V_Batch Where WhCode='" & Trim(strWhCode) & "' and MNumber='" & Trim(strMNum) & " '" & _
            " and BatchNum='" & Trim(strBatch) & "' order by IsQc DESC"
    Else
        Sqlstr = "Select * FROM  kf_V_Batch Where WhCode='" & Trim(strWhCode) & "' and MNumber='" & Trim(strMNum) & " '" & _
            " and BatchNum='" & Trim(strBatch) & "' and IsCk=0 order by IsQc,FatherTableNum"
    End If
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    With RecTemp
        If Not .EOF Then
            '对此相同批号的纪录求和
            intCount = .RecordCount
            ReDim intFatherID(1 To intCount)
            ReDim intChildID(1 To intCount)
            ReDim IsQc(1 To intCount)
            For tempJsq = 1 To intCount
                IsQc(tempJsq) = CBool(.Fields("isqc"))
                intFatherID(tempJsq) = .Fields("FatherTableNum")
                intChildID(tempJsq) = .Fields("SubTableNum")
            Next tempJsq
            BatchJudge = 0
        Else
            '此批号不存在
            BatchJudge = 1
            Exit Function
        End If
    End With
    
    RecTemp.Close
    Set RecTemp = Nothing

End Function
Public Function RestoreQuan(intCount As Integer, intFatherID() As Integer, intChildID() As Integer, IsQc() As Boolean, dblQuan As Double, flag As Boolean)
'函数功能:当进行批次管理的物料进行出库操作时，回写此物料在采购入库单中相应批次的累计出库数量值(AddupIssueQuan)
'输入参数:intCount-------回写记录的数量     intFatherID---------收发记录主表ID      intChildID--------收发记录子表ID
'           IsQc  -------是否为期初数据(1--期初 0--入库)        dblQuan---------回写数量
'           flag  -------增加删除标志(True---AddupIssueQuan减少  False---AddupIssueQuan增加)
'编制说明:当同一种物料同一种批次同一个仓库的记录有一条以上时,如果出库的数量大于其中的一条,回写时应作相应判断

    Dim RecTempADO As New ADODB.Recordset
    Dim adoRec As New ADODB.Recordset
    Dim Sqlstr As String
    Dim jsq As Integer
    Dim MinFID As Integer
    Dim MinCID As Integer
    Dim dblTotalQuan As Double
    Dim dblIssue As Double
    Dim dblTemp As Double
    
    For jsq = 1 To intCount
        If IsQc(jsq) = False Then
            Sqlstr = "select Quan,IssueQuan from kf_startsub where startMainid=" & intFatherID(jsq) & " and startsubid=" & intChildID(jsq)
        Else
            Sqlstr = "select FactReceiptQuan,AddupIssueQuan from gy_inoutsub where InOutMainid=" & intFatherID(jsq) & " and Inoutsubid=" & intChildID(jsq)
        End If
        
        Set RecTempADO = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        
        With RecTempADO
            If Not .EOF Then
                If IsQc(jsq) = False Then
                    dblTotalQuan = .Fields("quan")
                    dblIssue = .Fields("issuequan")
                Else
                    dblTotalQuan = .Fields("FactReceiptQuan")
                    dblIssue = .Fields("AddupIssueQuan")
                End If
            Else
                '改记录已经被删除
                
            End If
        End With
        RecTempADO.Close
        Set RecTempADO = Nothing
        
        If flag = False Then
            dblTemp = dblTotalQuan - dblIssue
            If dblTemp < dblQuan Then
                If IsQc(jsq) = False Then
                    Cw_DataEnvi.DataConnect.Execute ("Update kf_startsub set issuequan=issuequan+" & dblTemp & " where startMainid=" & intFatherID(jsq) & " and startsubid=" & intChildID(jsq))
                Else
                    Cw_DataEnvi.DataConnect.Execute ("Update gy_inoutsub set AddupIssueQuan=AddupIssueQuan+" & dblTemp & " where InOutMainid=" & intFatherID(jsq) & " and InOutsubid=" & intChildID(jsq))
                End If
            Else
                If IsQc(jsq) = False Then
                    Cw_DataEnvi.DataConnect.Execute ("Update kf_startsub set issuequan=issuequan+" & dblQuan & " where startMainid=" & intFatherID(jsq) & " and startsubid=" & intChildID(jsq))
                Else
                    Cw_DataEnvi.DataConnect.Execute ("Update gy_inoutsub set AddupIssueQuan=AddupIssueQuan+" & dblQuan & " where InOutMainid=" & intFatherID(jsq) & " and InOutsubid=" & intChildID(jsq))
                End If
                Exit For
            End If
        Else
            If dblIssue < dblQuan Then
                If IsQc(jsq) = False Then
                    Cw_DataEnvi.DataConnect.Execute ("Update kf_startsub set issuequan=issuequan-" & dblIssue & " where startMainid=" & intFatherID(jsq) & " and startsubid=" & intChildID(jsq))
                Else
                    Cw_DataEnvi.DataConnect.Execute ("Update gy_inoutsub set AddupIssueQuan=AddupIssueQuan-" & dblIssue & " where InOutMainid=" & intFatherID(jsq) & " and InOutsubid=" & intChildID(jsq))
                End If
            Else
                If IsQc(jsq) = False Then
                    Cw_DataEnvi.DataConnect.Execute ("Update kf_startsub set issuequan=issuequan-" & dblQuan & " where startMainid=" & intFatherID(jsq) & " and startsubid=" & intChildID(jsq))
                Else
                    Cw_DataEnvi.DataConnect.Execute ("Update gy_inoutsub set AddupIssueQuan=AddupIssueQuan-" & dblQuan & " where InOutMainid=" & intFatherID(jsq) & " and InOutsubid=" & intChildID(jsq))
                End If
                Exit For
            End If
        End If
        
    Next jsq
    
    
End Function

Public Function KFChangeCG(dblQuan As Double, strMnumber As String, intStatus As Integer) As Double
'函数功能：将库存的数量转换成采购计量单位的数量--intStatus=0(采购到库存) intStatus=1(库存到采购)

    Dim RecTemp As New ADODB.Recordset
    Dim Sqlstr As String

    Sqlstr = "Select PurInvCon1,PurInvCon2,MNumber FROM  Gy_Material Where MNumber='" & Trim(strMnumber) & " '"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)

    With RecTemp
        If Not .EOF Then
            If intStatus = 1 Then
                KFChangeCG = dblQuan / (.Fields("PurInvCon1") / .Fields("PurInvCon2"))
            Else
                KFChangeCG = dblQuan * (.Fields("PurInvCon1") / .Fields("PurInvCon2"))
            End If
        End If
    End With
    
    RecTemp.Close
    Set RecTemp = Nothing
    
End Function
Public Function KFChangeXS(dblQuan As Double, strMnumber As String, intStatus As Integer) As Double
'函数功能：将库存的数量转换成销售计量单位的数量--intStatus=0(销售到库存) intStatus=1(库存到销售)

    Dim RecTemp As New ADODB.Recordset
    Dim Sqlstr As String

    Sqlstr = "Select SaleInvCon1,SaleInvCon2,MNumber FROM  Gy_Material Where MNumber='" & Trim(strMnumber) & " '"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)

    With RecTemp
        If Not .EOF Then
            If intStatus = 1 Then
                KFChangeXS = dblQuan / (.Fields("SaleInvCon1") / .Fields("SaleInvCon2"))
            Else
                KFChangeXS = dblQuan * (.Fields("SaleInvCon1") / .Fields("SaleInvCon2"))
            End If
        End If
    End With
    
    RecTemp.Close
    Set RecTemp = Nothing
    
End Function

Public Function KFNowQuan(strWhCode As String, strMNum As String, strMArea As String, strBatch As String, dblEndQuan As Double, MainID As Long, dblNow As Double) As Integer
'函数功能：现存量判断--KFNowQuan=0(输入批此)   Status=1(输入数量与现存量表中的高储和低储值比较)
'输入参数：MainID---主表ID
    
    Dim RecTemp As New ADODB.Recordset
    Dim recADO As New ADODB.Recordset
    Dim tempSQL As String
    Dim Sqlstr As String
    Dim tempQuan As Double

    If strMArea <> "" Then
        Sqlstr = "Select SUM(EndQuan) AS EndQuan FROM  Kf_NowQuan Where MNumber='" & Trim(strMNum) & "' and WhCode='" & Trim(strWhCode) & "' and MArea='" & Trim(strMArea) & "' and BatchNum='" & Trim(strBatch) & "'"
        tempSQL = "Select FactIssueQuan from gy_inoutsub where inoutMainID=" & MainID & " and MNumber='" & Trim(strMNum) & "' and MArea='" & Trim(strMArea) & "' and BatchNum='" & Trim(strBatch) & "'"
    Else
        Sqlstr = "Select SUM(EndQuan) AS EndQuan FROM  Kf_NowQuan Where MNumber='" & Trim(strMNum) & " ' and WhCode='" & Trim(strWhCode) & "' and MArea IS NULL and BatchNum='" & Trim(strBatch) & "'"
        tempSQL = "Select FactIssueQuan FROM Gy_InOutsub WHERE inoutMainID=" & MainID & " and MNumber='" & Trim(strMNum) & "' and MArea IS NULL and BatchNum='" & Trim(strBatch) & "'"
    End If
    
    Set recADO = Cw_DataEnvi.DataConnect.Execute(tempSQL)
    With recADO
        If Not .EOF Then
            If Not IsNull(.Fields("FactIssueQuan")) Then
                tempQuan = .Fields("FactIssueQuan")
            End If
        End If
    End With
    recADO.Close
    Set recADO = Nothing
    
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    With RecTemp
        If Not .EOF Then
            If IsNull(.Fields("EndQuan")) Then
                RecTemp.Close
                Set RecTemp = Nothing
                dblNow = 0
                KFNowQuan = 0
                Exit Function
            Else
                dblNow = .Fields("EndQuan") + tempQuan
                If dblNow - dblEndQuan < 0 Then
                    KFNowQuan = 0
                Else
                    KFNowQuan = 1
                End If
            End If
        Else
            RecTemp.Close
            Set RecTemp = Nothing
            dblNow = 0
            KFNowQuan = 0
            Exit Function
        End If
    End With
    
    RecTemp.Close
    Set RecTemp = Nothing
    
End Function

Public Function Fun_ClrkdKfsc() As Boolean  '材料入库单是否库存生成
    Dim int_temp As Integer
    Dim rst_temp As New ADODB.Recordset
    Set rst_temp = Cw_DataEnvi.DataConnect.Execute("select * from Gy_AccInformation where ltrim(rtrim(ItemCode))='Chhs_ClrkdKfsc'")
    If rst_temp.RecordCount <> 0 Then
        If Trim("" & rst_temp.Fields("ItemValue")) = "1" Then
            Fun_ClrkdKfsc = True
        Else
            Fun_ClrkdKfsc = False
        End If
    Else
            Fun_ClrkdKfsc = False
    End If
    rst_temp.Close
    Set rst_temp = Nothing
End Function
Public Function Judge_NowDate() As Boolean '登陆是否为当前会计期间
    Dim Tsxx As String
    Dim temp_recordset As ADODB.Recordset
    Set temp_recordset = Cw_DataEnvi.DataConnect.Execute("SELECT TOP 1 Kjyear, Period FROM Gy_kjrlb WHERE (Kfjzbz = 0) ORDER BY Kjyear, Period")
    If Not temp_recordset.EOF Then
        If Xtmm <> temp_recordset.Fields("Period") Or Xtyear <> temp_recordset.Fields("Kjyear") Then
            Tsxx = "登录日期不在当前会计期间(" & Trim("" & temp_recordset.Fields("Kjyear")) & "-" & Trim("" & temp_recordset.Fields("Period")) & ")!"
             Call Xtxxts(Tsxx, 0, 4)
             Judge_NowDate = False
        Else
             Judge_NowDate = True
        End If
    Else
             Judge_NowDate = False
    End If
    temp_recordset.Close
    Set temp_recordset = Nothing
End Function
Public Sub NowQuanManage()
    
    Dim YesNo As Integer
    Dim Tsxx As String
    
    Tsxx = "是否整理现存量?"
    YesNo = Xtxxts(Tsxx, 1, 2)
    If YesNo <> 6 Then
        Exit Sub
    End If
    
    With XT_FrmWaitMess
        .Show
        .Label1.Caption = "正在整理现存量!"
        .Refresh
    End With
    
    Cw_DataEnvi.DataConnect.BeginTrans
    Cw_DataEnvi.DataConnect.Execute ("KF_SP_ModiNowQuan")
    Cw_DataEnvi.DataConnect.CommitTrans
    Unload XT_FrmWaitMess
    Tsxx = "现存量整理完毕!"
    Call Xtxxts(Tsxx, 0, 4)
    Exit Sub

End Sub