-

VB开发的ERP系统

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

Public GBln_IfLinkStock As Boolean                           '进料检验与采购接口
Public GBln_StockJudge As Boolean                            '进料检验自动判断检验结果
Public GBln_ProductJudge As Boolean                          '成品检验自动判断检验结果
Public GBln_MidJudge As Boolean                              '中控检验自动判断合格
Public GBln_DefineMidMaterial As Boolean                     '自定义中控物料编码

Public Sub Drxtcs()                                   '读入系统参数
    
    Dim Ztcsbrec As New ADODB.Recordset
    
    GBln_IfLinkStock = False
    GBln_StockJudge = False
    GBln_ProductJudge = False
    GBln_MidJudge = False
    GBln_DefineMidMaterial = True
    
    '[>>查询连接串
    Sqlstr = "select * from Qc_CheckParaSet"
    '<<]
    Set Ztcsbrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)

    With Ztcsbrec
        If .EOF And .BOF Then
            Exit Sub
        End If
        If .Fields("IfLinkStock") = True Then GBln_IfLinkStock = True
        If .Fields("StockJudge") = True Then GBln_StockJudge = True
        If .Fields("ProductJudge") = True Then GBln_ProductJudge = True
        If .Fields("MidJudge") = True Then GBln_MidJudge = True
        If .Fields("DefineMidMaterial") = False Then GBln_DefineMidMaterial = False
    End With

End Sub

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 Function ReportItem(ReportName As Integer) As Boolean            '判断是否有检验项目（传递参数 1为废水，2为废气，3为工作环境）
    Dim Tsxx As String
    Dim Rec_Temp As New ADODB.Recordset      '临时使用动态集
    ReportItem = True
    Set Rec_Temp = Nothing
    Select Case ReportName
        Case 1
            Sqlstr = "Select distinct ItemId,ItemName From Qc_WorkEnvirItem Where Style='1' Order By ItemId"
            Set Rec_Temp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            If Rec_Temp.EOF And Rec_Temp.BOF Then
                Tsxx = "请先建立废水的监测项目"
                Call Xtxxts(Tsxx, 0, 4)
                ReportItem = False
                Exit Function
            End If
        Case 2
            Sqlstr = "Select distinct ItemId,ItemName From Qc_WorkEnvirItem Where Style='2' Order By ItemId"
            Set Rec_Temp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            If Rec_Temp.EOF And Rec_Temp.BOF Then
                Tsxx = "请先建立废气的监测项目"
                Call Xtxxts(Tsxx, 0, 4)
                ReportItem = False
                Exit Function
            End If
        Case 3
            Sqlstr = "Select distinct ItemId,ItemName From Qc_WorkEnvirItem Where Style='3' Order By ItemId"
            Set Rec_Temp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            If Rec_Temp.EOF And Rec_Temp.BOF Then
                Tsxx = "请先建立工作环境的监测项目"
                Call Xtxxts(Tsxx, 0, 4)
                ReportItem = False
                Exit Function
            End If
    End Select
End Function