企业管理

开发平台：
Visual Basic

-：源码内容
							Attribute VB_Name = "XtsyModule"
'系统私有模块用来放置一些子系统独有的过程与函数
Public str_Code As String                               '存储列内容参数
Public conAlart As Long                                 '高储低储预警
Public conArea As Long                                  '货区管理
Public conExceed As Long                                '超限额领料
Public conForbid As Long                                '盘点冻结出入库
Public conBatch As Long                                 '批次管理
Public conQuan As Long                                  '保值期管理
Public conAllow As Long                                 '允许负出库
Public conHLJudge As Long                               '高储和低储判断标准
Public strHlpR As String
Public strM As String                                    '物料编码
Public S1 As String
Public PriceMode As String
Public RBFlag As Integer                                 '红字兰字标识
Const AreaString = "货区"
Const BatchString = "批号"
Const QuanString = "失效日期"
Public Sub Drxtztcs()                                   '读入系统帐套参数
   
    Dim Ztcsbrec As New ADODB.Recordset
    Dim RecTemp As New ADODB.Recordset
    Dim Sqlstr As String
  
    With Ztcsbrec
        '金额总位数
        .Open "Select * From Gy_AccInformation Where SystemCode='Cwzz'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        .MoveFirst
        .Find "itemcode='cwjezws'"
        If Not Ztcsbrec.EOF Then
            Xtjezws = Val(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
        
        '数量总位数
        .MoveFirst
        .Find "itemcode='cwslzws'"
        If Not Ztcsbrec.EOF Then
            Xtslzws = Val(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
   
        '单价总位数
        .MoveFirst
        .Find "itemcode='cwdjzws'"
        If Not Ztcsbrec.EOF Then
            Xtdjzws = Val(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
        
        '金额小数位数
        .MoveFirst
        .Find "itemcode='cwjexsws'"
        If Not Ztcsbrec.EOF Then
            Xtjexsws = Val(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
   
        '数量小数位数
        .MoveFirst
        .Find "itemcode='cwslxsws'"
        If Not Ztcsbrec.EOF Then
            Xtslxsws = Val(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
        
        '单价小数位数
        .MoveFirst
        .Find "itemcode='cwdjxsws'"
        If Not Ztcsbrec.EOF Then
            Xtdjxsws = Val(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
        .Close
    End With
  
End Sub
Public Sub getSysDef()
'模块功能：得到系统设置信息
    Dim adoRec As New ADODB.Recordset
    Dim intNum As Integer
    If adoRec.State = 1 Then adoRec.Close
    Set adoRec = Cw_DataEnvi.DataConnect.Execute("select * from gy_accinformation where systemcode='kf'")
    With adoRec
        If Not .EOF Then
            .MoveFirst
            For intNum = 1 To .RecordCount
                Select Case Trim(.Fields("itemcode"))
                    Case "KF_Area"
                        conArea = Val(.Fields("itemvalue"))
                    Case "KF_Batch"
                        conBatch = Val(.Fields("itemvalue"))
                    Case "KF_Quan"
                        conQuan = Val(.Fields("itemvalue"))
                    Case "KF_Exceed"
                        conExceed = Val(.Fields("itemvalue"))
                    Case "KF_Forbid"
                        conForbid = Val(.Fields("itemvalue"))
                    Case "KF_Alart"
                        conAlart = Val(.Fields("itemvalue"))
                    Case "KF_Allow"
                        conAllow = Val(.Fields("itemvalue"))
                    Case "KF_HLFlag"
                        conHLJudge = Val(.Fields("itemvalue"))
                End Select
                .MoveNext
            Next intNum
        End If
        .Close
    End With
    Set adoRec = Nothing
End Sub
Public Function Clrkdkfsc() As Boolean
'模块功能：判断材料入库单是否由库存系统生成
    Dim adoRec As New ADODB.Recordset
    Dim intNum As Integer
    If adoRec.State = 1 Then adoRec.Close
    Set adoRec = Cw_DataEnvi.DataConnect.Execute("select * from gy_accinformation where systemcode='chhs' AND itemcode='Chhs_ClrkdKfsc'")
    With adoRec
        If Not .EOF Then
            If Trim(.Fields("itemvalue")) = 1 Then
                Clrkdkfsc = True
            Else
                Clrkdkfsc = False
            End If
        End If
    End With
    adoRec.Close
    Set adoRec = Nothing
End Function
Public Function CheckRefTable(KeyValue As Variant, KeyName As String, RefTable As String, Optional KeyCon As String, Optional KeyConName As String) As Boolean
 Dim adoReturn As New ADODB.Recordset
 Dim str As String
 Dim Status As Integer
 
  CheckRefTable = False
  Status = 0
    If KeyCon <> "" Then
     Status = 1
    End If
        str = "KF_SP_CheckRefTable '" & Trim(KeyValue) & "','" & Trim(KeyName) & "','" & Trim(RefTable) & "','" & Trim(KeyCon) & "','" & Trim(KeyConName) & "'," & Val(Status)
        Set adoReturn = Cw_DataEnvi.DataConnect.Execute(str)
        If Not adoReturn.EOF Then
         If adoReturn.Fields("f1") Then
          CheckRefTable = True
         Else
          CheckRefTable = False
         End If
        End If
        adoReturn.Close
        Set adoReturn = Nothing
End Function
Public Function LrTextFHXZ(lrzfasc As Integer) As Boolean       '文本框录入非特殊符号限制
    LrTextFHXZ = True
    If (lrzfasc >= -23645 And lrzfasc <= -23643) Or lrzfasc = -23617 Or lrzfasc = -24150 Or (lrzfasc <= -24156 And lrzfasc >= -24158) Or lrzfasc = -23647 Or lrzfasc = -24147 Or lrzfasc = -23621 Or lrzfasc = -23636 Or lrzfasc = -23638 Or lrzfasc = 124 Or lrzfasc = 94 Or lrzfasc = 96 Or lrzfasc = 126 Or lrzfasc = 247 Or lrzfasc = 165 Or (lrzfasc <= 64 And lrzfasc >= 58) Or (lrzfasc >= 42 And lrzfasc <= 45) Or lrzfasc = 46 Or (lrzfasc >= 32 And lrzfasc <= 39) Then
        LrTextFHXZ = False
        lrzfasc = 0
    End If
End Function
Public Sub ShowOrHideCol(WglrGrid As vsFlexGrid, strGridCode As String, GridStr() As String, Szzls As Integer)
'函数功能：显示或隐藏相应列
    
    Dim adoRec As New ADODB.Recordset                   'ADO连接
    Dim strColTitle As String                           '列标题
    Dim strColIndex As String                           '列索引
    Dim strSQL As String                                '查询连接字符串
    
    strSQL = "SELECT * FROM XT_Grid WHERE Grid_Code='" & strGridCode & "' AND ColHidden=1 ORDER BY ColIndex"
    Set adoRec = Cw_DataEnvi.DataConnect.Execute(strSQL)
    
    With adoRec
        If Not .EOF Then
            .MoveFirst
            Do While Not .EOF
                strColIndex = Trim(.Fields("ColIndex"))
                strColTitle = Trim(.Fields("ColTitle1"))
                If conArea = 1 And AreaString = strColTitle Then
                    WglrGrid.ColHidden(Sydz(strColIndex, GridStr(), Szzls)) = False
                End If
                If conBatch = 1 And BatchString = strColTitle Then
                    WglrGrid.ColHidden(Sydz(strColIndex, GridStr(), Szzls)) = False
                End If
                If conQuan = 1 And QuanString = strColTitle Then
                    WglrGrid.ColHidden(Sydz(strColIndex, GridStr(), Szzls)) = False
                End If
                .MoveNext
            Loop
        End If
    End With
    
    adoRec.Close
    Set adoRec = Nothing
    
End Sub
Public Function FunHlpR(str1 As String, str2 As String, str3 As String) As String
'通用帮助函数     str1----帮助编码  str2---条件字段    str3----条件值
 Dim adoTemp As New ADODB.Recordset
    Set adoTemp = Cw_DataEnvi.DataConnect.Execute("KF_SP_Xthelp '" & Trim(str1) & "','" & Trim(str2) & "','" & Trim(str3) & "'")
    If Not adoTemp.EOF Then
        FunHlpR = Trim(adoTemp.Fields("r1"))
    End If
End Function
Public Function HelpString(intCount As Integer, hlpCondition() As String, hlpValue() As String) As String
    Dim tempJsq As Integer
    
    ReDim hlpCondition(0 To intCount - 1)
    ReDim hlpValue(0 To intCount - 1)
    
    HelpString = HelpString & hlpCondition(0) & "='" & hlpValue(0) & "'"
    If intCount > 1 Then
        For tempJsq = 1 To intCount - 1
            HelpString = HelpString & " and " & hlpCondition(tempJsq) & "='" & hlpValue(tempJsq) & "'"
        Next tempJsq
    End If
    
End Function
Public Function CheckArea(strWhCode As String, strArea As String, AreaCode As String, AreaName As String) As Boolean
'函数功能：进行货区管理时,用户输入货区的合法性检查,CheckArea=True时表示货区输入有误
    
    Dim adoRec As New ADODB.Recordset                   'ADO连接
    Dim strSQL As String                                '查询连接字符串
    
    strSQL = "SELECT * FROM KF_MArea WHERE WhCode='" & strWhCode & "' and (MArea='" & strArea & "' OR MAreaName='" & strArea & "') and endflag=1"
    Set adoRec = Cw_DataEnvi.DataConnect.Execute(strSQL)
    
    With adoRec
        If .EOF Then
            CheckArea = True
        Else
            CheckArea = False
            AreaCode = .Fields("MArea")
            AreaName = .Fields("MAreaName")
        End If
    End With
    
    adoRec.Close
    Set adoRec = Nothing
End Function
Public Function CheckBillDate(LrText As TextBox, Kjyear As Integer, Period As Integer) As Boolean
'函数功能：判断用户输入的制单日期是否已经结帐,CheckBillDate为True时,表示已经结帐
    Dim RecTemp As New ADODB.Recordset
    Dim Sqlstr As String
    Dim Tsxx As String
    
    Sqlstr = "Select * FROM  Gy_Kjrlb Where Qsrq<='" & LrText & "' and zzrq>='" & LrText & "' and kjyear=" & Mid(LrText, 1, 4)
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    With RecTemp
        If Not .EOF Then
            If .Fields("kfjzbz") Then
               CheckBillDate = True
               Tsxx = "所选会计期间已经结帐,不能再填制单据!"
               Call Xtxxts(Tsxx, 0, 1)
               LrText.SetFocus
               Exit Function
            Else
               CheckBillDate = False
               Kjyear = Val(.Fields("kjyear"))
               Period = Val(.Fields("Period"))
            End If
        Else
            CheckBillDate = True
            Tsxx = "所选年度不正确!"
            Call Xtxxts(Tsxx, 0, 1)
            LrText.SetFocus
            Exit Function
        End If
    End With
    
    RecTemp.Close
    Set RecTemp = Nothing
End Function
Public Function CheckStartFinish() As Boolean
'函数功能：判断初始化是否完成
    Dim RecTemp As New ADODB.Recordset
    Dim Sqlstr As String
    Dim Tsxx As String
    
    Sqlstr = "Select * FROM  Gy_AccInformation Where systemcode='KF' and itemcode='KFInit'"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    With RecTemp
        If CBool(.Fields("ItemValue")) = True Then
            CheckStartFinish = True
        Else
            CheckStartFinish = False
        End If
    End With
        
    RecTemp.Close
    Set RecTemp = Nothing
        
End Function
Public Function KFHLJudge(Status As Integer, strWhCode As String, strMNum As String, strMArea As String, dblEndQuan As Double, InOutFlag As Integer, MainID As Long)
'函数功能：库存高储和低储判断--Status=0(输入数量与物料表中的高储和低储值比较)   Status=1(输入数量与现存量表中的高储和低储值比较)
    
    Dim RecTemp As New ADODB.Recordset
    Dim recADO As New ADODB.Recordset
    Dim tempSQL As String
    Dim tempQuan As Double
    Dim Sqlstr As String
    Dim Tsxx As String
    Dim dblHigh As Double
    Dim dblLow As Double
    Dim dblNow As Double
    '从收发记录主表中得到结果
    If strMArea <> "" Then
        tempSQL = "Select sum(AddupIssueQuan) as AddupIssueQuan from gy_inoutsub where inoutMainID=" & MainID & " and MNumber='" & Trim(strMNum) & "' and MArea='" & Trim(strMArea) & "'"
    Else
        tempSQL = "Select sum(AddupIssueQuan) as AddupIssueQuan FROM Gy_InOutsub WHERE inoutMainID=" & MainID & " and MNumber='" & Trim(strMNum) & "' and MArea IS NULL "
    End If
    If Status = 0 Then
        Sqlstr = "Select HighStorage,LowStorage,NowStorage FROM  Gy_Material Where MNumber='" & Trim(strMNum) & " '"
    Else
        If strMArea <> "" Then
            Sqlstr = "Select Max(HighQuan) AS HighQuan,MIN(LowQuan) AS LowQuan,SUM(EndQuan) AS EndQuan FROM  Kf_NowQuan Where MNumber='" & Trim(strMNum) & " ' and WhCode='" & Trim(strWhCode) & "' and MArea='" & Trim(strMArea) & "'"
        Else
            Sqlstr = "Select Max(HighQuan) AS HighQuan,MIN(LowQuan) AS LowQuan,SUM(EndQuan) AS EndQuan FROM  Kf_NowQuan Where MNumber='" & Trim(strMNum) & " ' and WhCode='" & Trim(strWhCode) & "' and MArea IS NULL"
        End If
    End If
    '从收发记录表中查找符合条件的记录
    Set recADO = Cw_DataEnvi.DataConnect.Execute(tempSQL)
    With recADO
        If Not .EOF Then
            If Not IsNull(.Fields("AddupIssueQuan")) Then
                tempQuan = .Fields("AddupIssueQuan")
            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 Status = 0 Then
                dblHigh = .Fields("HighStorage")
                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

						