-

VB开发的ERP系统

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

 Public Xt_XtJc As Boolean            '系统集成
 Public StartMon As Integer           '开帐月份
 Public LastMon As Integer            '当前年度最后一个月份
 Public Qmclcy As Boolean             '期末是否处理差异
 Public ClrkdKfsc As Boolean          '材料入库单库存管理系统生成
 Public Xtclzg As Boolean             '系统是否处理暂估
 Public Cylzg As Boolean              '差异率计算是否包括本期暂估
 Public LcbckFs As Integer            '零成本出库方式
 Public EvalFs As Integer             '暂估方式
 Public SFjezt As Boolean             '系统处理实发金额自填
 
 '生成凭证的信息
 Public vouchdata() As Variant
 Public vouchz As String
 Public PzRecordCount As Integer
 Public PzDataRow As Integer
 
 Public Price_Flag As Boolean         '单价标记
 Public Edit_Flag As Boolean          '编辑标志
 
 Dim Tsxx 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
    
   With Rectemp
        If .State = 1 Then .Close
        .Open "Select * From Gy_AccInformation Where SystemCode='chhs'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic

        '期末是否处理差异
        .MoveFirst
        .Find "itemcode='Chhs_Qmclcy'"
        If Not .EOF Then
           If .Fields("itemvalue") = 1 Then
              Qmclcy = True
           Else
              Qmclcy = False
           End If
        End If
        
        '系统是否处理暂估
        .MoveFirst
        .Find "itemcode='Chhs_Xtclzg'"
        If Not .EOF Then
           If .Fields("itemvalue") = 1 Then
              Xtclzg = True
           Else
              Xtclzg = False
           End If
        End If
        
        '差异率计算是否包括暂估
        .MoveFirst
        .Find "itemcode='Chhs_Cylzg'"
        If Not .EOF Then
           If .Fields("itemvalue") = 1 Then
              Cylzg = True
           Else
              Cylzg = False
           End If
        End If
        
        '材料入库单是否是库房系统生成
        .MoveFirst
        .Find "itemcode='Chhs_ClrkdKfsc'"
        If Not .EOF Then
           If .Fields("itemvalue") = 1 Then
              ClrkdKfsc = True
           Else
              ClrkdKfsc = False
           End If
        End If
        
         '系统集成
        .MoveFirst
        .Find "itemcode='chhs_xtjc'"
        If Not .EOF Then
           If .Fields("itemvalue") = 1 Then
              Xt_XtJc = True
           Else
              Xt_XtJc = False
           End If
        End If
         
         '暂估方式
        .MoveFirst
        .Find "itemcode='Chhs_Eval1'"
        If Not .EOF Then
           If .Fields("itemvalue") = 1 Then
              EvalFs = 1
           End If
        End If
        .MoveFirst
        .Find "itemcode='Chhs_Eval2'"
        If Not .EOF Then
           If .Fields("itemvalue") = 1 Then
              EvalFs = 3
           End If
        End If
        .MoveFirst
        .Find "itemcode='Chhs_Eval3'"
        If Not .EOF Then
           If .Fields("itemvalue") = 1 Then
              EvalFs = 3
           End If
        End If
         
         '零成本出库方式
        .MoveFirst
        .Find "itemcode='Chhs_Lcbck1'"
        If Not .EOF Then
           If .Fields("itemvalue") = 1 Then
              LcbckFs = 1
           End If
        End If
        .MoveFirst
        .Find "itemcode='Chhs_Lcbck2'"
        If Not .EOF Then
           If .Fields("itemvalue") = 1 Then
              LcbckFs = 2
           End If
        End If
        .MoveFirst
        .Find "itemcode='Chhs_Lcbck3'"
        If Not .EOF Then
           If .Fields("itemvalue") = 1 Then
              LcbckFs = 3
           End If
        End If
        .MoveFirst
        .Find "itemcode='Chhs_Lcbck4'"
        If Not .EOF Then
           If .Fields("itemvalue") = 1 Then
              LcbckFs = 4
           End If
        End If
        .MoveFirst
        .Find "itemcode='Chhs_Lcbck5'"
        If Not .EOF Then
           If .Fields("itemvalue") = 1 Then
              LcbckFs = 5
           End If
        End If
        
        '系统处理实发金额自填
        .MoveFirst
        .Find "itemcode='Chhs_SFjezt'"
        If Not .EOF Then
           If .Fields("itemvalue") = 1 Then
              SFjezt = True
           Else
              SFjezt = False
           End If
        End If
    End With
  
    '开帐月份
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select * from gy_kjrlb where kjyear=" & Xtyear & " and beginflag=1")
    If Not Rectemp.EOF Then
        StartMon = Rectemp.Fields("period")
        Cw_DataEnvi.DataConnect.Execute ("update gy_kjrlb set chhsjzbz=1 where period<" & StartMon & " and kjyear=" & Xtyear)
    Else
        StartMon = 1
    End If
    
    '终止月份
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select * from gy_kjrlb where kjyear=" & Xtyear & " order by period desc ")
    If Not Rectemp.EOF Then
        LastMon = Rectemp.Fields("period")
    End If
    
End Sub

Public Function KjMonth(Datestr As Date) As Integer              '当前会计月份  bfy

    Dim Rectemp As Recordset
   
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select * from gy_kjrlb where kjyear=" & PGKjYear & " and '" & Format(Datestr, "yyyy-mm-dd") & "' between qsrq and zzrq ")
   
    If Not Rectemp.EOF Then
        KjMonth = Rectemp.Fields("period")
    Else
        Tsxx = "此会计月份不存在!"
        Call Xtxxts(Tsxx, 0, 1)
    End If
   
End Function

Public Function PGKjYear() As Integer              '当前会计年度
    Dim Rectemp As Recordset
   
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select * from gy_kjrlb where chhsjzbz=0 order by kjyear,period")