私有模块.bas

新世纪ERP包装物管理源代码

Attribute VB_Name = "XtsyModule"
'系统私有模块用来放置一些子系统独有的过程与函数
Public str_Code As String                               '存储列内容参数

'系统传递单据ID
Public Cask_BillID As Long
Public XtCaskInf As String        '附属物帮助传递参数值(专门用来传递帮助信息)

Public Sub Drxtztcs()                                   '读入系统帐套参数
   
    Dim Ztcsbrec As New ADODB.Recordset
    Dim RecTemp As New ADODB.Recordset
    Dim Sqlstr As String
  
  
     '读入本位币
    Sqlstr = "Select ForeignCurrCode,ForeignCurrName from Gy_ForeignCurrency where StandardFlag=1"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    XtSCurrCode = Trim(RecTemp.Fields("ForeignCurrCode"))
    XtSCurrName = Trim(RecTemp.Fields("ForeignCurrName"))
    
    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 Cask_StartChalk()            '期初结帐
    Dim Rec_Query As ADODB.Recordset
    Dim Sqlstr As String
    Dim Tsxx As String
    
    Tsxx = "请确认是否要进行期初结帐?"
    YAnswer = Xtxxts(Tsxx, 2, 2)
   
    If YAnswer <> 1 Then Exit Sub
    Sqlstr = "SELECT * FROM Cask_V_StartInputList where BillType=1"
    Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    If Rec_Query.EOF Then
        Sqlstr = "select * from gy_accinformation where ItemCode='Cask_StartChalk'"
        Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        If Val(Trim(Rec_Query!ItemValue)) = 1 Then
            Tsxx = "期初已结帐!"
            Call Xtxxts(Tsxx, 0, 1)
        Else
            Cw_DataEnvi.DataConnect.Execute ("Update gy_accinformation Set ItemValue=1 Where ItemCode='Cask_StartChalk'")
            Tsxx = "期初结帐完成!"
            Call Xtxxts(Tsxx, 0, 4)
        End If
        Exit Sub
    End If
    
    Sqlstr = "SELECT * FROM Cask_V_StartInputList where BillType=1 and Reckoning=1"
    Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    If Not Rec_Query.EOF Then
        Tsxx = "期初已结帐!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    End If
    
    Sqlstr = "SELECT * FROM Cask_V_StartInputList where BillType=1 and Checker=''"
    Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    If Not Rec_Query.EOF Then
        Tsxx = "有未审核的单据，不能进行期初结帐!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    End If
    Set Rec_Query = Cw_DataEnvi.DataConnect.Execute("select kjyear,period from gy_kjrlb where beginflag=1")
    
    Sqlstr = "INSERT INTO Cask_Ledger (WhCode,WrappageCode,StatusName,StartQuan,kjyear,period)  SELECT WhCode,WrappageCode,StatusName,Sum(Quantity) as StartQuan," & Val(Rec_Query!KjYear) & "," & Val(Rec_Query!Period) & " FROM Cask_V_HarvestIssue where BillType=1 GROUP BY WhCode,WrappageCode,StatusName"
    Cw_DataEnvi.DataConnect.Execute (Sqlstr)
    
    Cw_DataEnvi.DataConnect.Execute ("Update Cask_HarvestIssueMain Set Reckoning=1 Where BillType=1")
    Cw_DataEnvi.DataConnect.Execute ("Update gy_accinformation Set ItemValue=1 Where ItemCode='Cask_StartChalk'")
    Tsxx = "期初结帐完成!"
    Call Xtxxts(Tsxx, 0, 4)

End Sub

Public Sub Cask_ComebackChalk()            '恢复期初结帐
    Dim Kjyear_Query As ADODB.Recordset
    Dim Rec_Query As ADODB.Recordset
    Dim Sqlstr As String
    Dim Tsxx As String
    
    Tsxx = "请确认是否要进行恢复期初结帐?"
    YAnswer = Xtxxts(Tsxx, 2, 2)
   
    If YAnswer <> 1 Then Exit Sub
    
    Sqlstr = "SELECT * FROM Cask_V_StartInputList where BillType=1"
    Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    If Rec_Query.EOF Then
        Sqlstr = "select * from gy_accinformation where ItemCode='Cask_StartChalk'"
        Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        If Val(Trim(Rec_Query!ItemValue)) = 0 Then
            Tsxx = "已恢复期初结帐!"
            Call Xtxxts(Tsxx, 0, 1)
        Else
            Cw_DataEnvi.DataConnect.Execute ("Update gy_accinformation Set ItemValue=0 Where ItemCode='Cask_StartChalk'")
            Tsxx = "期初结帐恢复完成!"
            Call Xtxxts(Tsxx, 0, 4)
        End If
        Exit Sub
    End If
    
    Set Kjyear_Query = Cw_DataEnvi.DataConnect.Execute("select kjyear,period from gy_kjrlb where CaskJzbz=1")
    
    If Not Kjyear_Query.EOF Then
        Kjyear_Query.MoveLast
        Sqlstr = "select * from Gy_Kjrlb where KJYear=" & Val(Kjyear_Query!KjYear) & " and period=" & Val(Kjyear_Query!Period)
        Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        
        If Rec_Query!CaskJzbz Then
            Tsxx = "已月末结帐，不能恢复期初结帐!"
            Call Xtxxts(Tsxx, 0, 1)
            Exit Sub
        End If
    End If
    
    Set Kjyear_Query = Cw_DataEnvi.DataConnect.Execute("select kjyear,period from gy_kjrlb where beginflag=1")
    
    Sqlstr = "SELECT * FROM Cask_V_StartInputList where BillType=1 and Reckoning=0"
    Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    If Not Rec_Query.EOF Then
        Tsxx = "已恢复期初结帐!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    End If
    
    Sqlstr = "Delete  Cask_Ledger Where kjyear=" & Val(Kjyear_Query!KjYear) & " and period=" & Val(Kjyear_Query!Period)
    Cw_DataEnvi.DataConnect.Execute (Sqlstr)
    Cw_DataEnvi.DataConnect.Execute ("Update Cask_HarvestIssueMain Set Reckoning=0 Where BillType=1")
    Cw_DataEnvi.DataConnect.Execute ("Update gy_accinformation Set ItemValue=0 Where ItemCode='Cask_StartChalk'")
    
    Tsxx = "期初结帐恢复完成!"
    Call Xtxxts(Tsxx, 0, 4)

End Sub
Public Function Cask_Kjrlb()         '查询当前会计期间
    Dim DateRecordset As ADODB.Recordset
    Dim R_Date As ADODB.Recordset
    
  Set DateRecordset = Cw_DataEnvi.DataConnect.Execute("select * from Gy_Kjrlb where CaskJzbz=0 ")
  Set R_Date = Cw_DataEnvi.DataConnect.Execute("select * from Gy_Kjrlb where beginflag=1 ")
  
  If DateRecordset.BOF And DateRecordset.EOF Then
    Set DateRecordset = Cw_DataEnvi.DataConnect.Execute("select * from Gy_Kjrlb where CaskJzbz=1 ")
    If Not DateRecordset.EOF Then
        DateRecordset.MoveLast
        Cask_Kjrlb = CDate(DateRecordset.Fields("zzrq") + 1)
    End If
  Else
    If R_Date!QSRQ > DateRecordset.Fields("qsrq") Then
        Cask_Kjrlb = CDate(R_Date.Fields("qsrq"))
    Else
        Cask_Kjrlb = CDate(DateRecordset.Fields("qsrq"))
    End If
  End If
End Function