-

VB开发的ERP系统

Attribute VB_Name = "XtsyModule"
'系统私有模块用来放置一些子系统独有的过程与函数
Public str_Code As String                               '存储列内容参数
Public KjYear As Integer                                '当前会计年
Public Period As Integer                                '当前会计月
Public sParam As String
Public sParam2 As String

Public Const DATA_NUMERIC As Integer = 5 '数字行
Public Const DATA_STRING As Integer = 0 '字符型
Public Const DATA_DATE As Integer = 7 '日期型
Const PRINTSTYLE_ONETITLE = 0 '每页打印表头
Const PRINTSTYLE_ALLTITLE = 1 '每行打印表头
Dim Sql As String
Dim SqlField As String
Dim Rsc As New ADODB.Recordset
Public Function Item_Info(sys As Integer)   '项目查询连接
'sys=0,人事系统调用;sys=1,工资系统调用
    Dim tmpRs As New Recordset
    Dim sSql As String
    If sys = 0 Then
        Set tmpRs = Cw_DataEnvi.DataConnect.Execute("select * from Rs_Items WHERE SID='1' ")
    Else
        Set tmpRs = Cw_DataEnvi.DataConnect.Execute("select * from Rs_Items WHERE SID='2' OR Pm='1' ")
    End If
    With tmpRs
        Do While Not .EOF
            
            If Trim(!CorTable) = "" Then                                               '非编码型的
                If Trim(!TableName) = "Rs_BasicInfo" Then
                    sSql = sSql & ",B." & !FieldName
                Else
                    sSql = sSql & ",E." & !FieldName
                End If
            Else
                If Trim(tmpRs!CorTable) = "Rs_CorSub" Then                                  '这个字段是编码型的，并且相关项的字段在Rs_CorSub
                    If Trim(!TableName) = "Rs_BasicInfo" Then
                        sSql = sSql & ",N_" & !FieldName & "=(select ListName from Rs_CorSub c where convert(varchar(18),c.ListId)=B." & !FieldName & ")"
                        sSql = sSql & ",B." & !FieldName
                    Else
                        sSql = sSql & ",N_" & !FieldName & "=(select ListName from Rs_CorSub c where convert(varchar(18),c.ListId)=E." & !FieldName & ")"
                        sSql = sSql & ",E." & !FieldName
                    End If
                    '-----------------
                Else                                                                         '这个字段是编码型的，但是相关项的字段表不确定的情况
                        If Trim(!TableName) = "Rs_BasicInfo" Then
                            sSql = sSql & ",N_" & !FieldName & "=(select " & Trim(tmpRs!IndexName) & " from " & Trim(tmpRs!CorTable) & " c where c." & Trim(tmpRs!IndexCode) & "=B." & !FieldName & ")"
                            sSql = sSql & ",B." & !FieldName
                        Else
                            sSql = sSql & ",N_" & !FieldName & "=(select " & Trim(tmpRs!IndexName) & " from " & Trim(tmpRs!CorTable) & " c where c." & Trim(tmpRs!IndexCode) & "=E." & !FieldName & ")"
                            sSql = sSql & ",E." & !FieldName
                        End If
                End If
            End If
            
            
            .MoveNext
        Loop
        sSql = "SELECT " & Mid(sSql, 2, Len(sSql) - 1) & " FROM Rs_ExtendInfo E,Rs_BasicInfo B"
    End With
    Item_Info = sSql

End Function

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 CurrPeriod()
    '读入当前会计期间
    Dim Rsc As New ADODB.Recordset
    Set Rsc = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM gy_kjrlb WHERE pmjzbz=0 order by kjyear,period")
    With Rsc
        If Not Rsc.EOF Then
           KjYear = Trim(!KjYear)
           Period = Trim(!Period)
        End If
    End With
End Sub

Public Function DynaFillImageCombo(Combote As ImageCombo, ComboCode As String, AddType As Integer, SqlString As String) '填充列表框(ImageCombo)并定
    '可在查询条件里加动态的条件
    '函数参数：列表框(ImageCombo)，ComboCode列表框分组编码
    'AddType 项目填充类型(0-填充索引+内容,无空记录 1-仅填充内容,无空记录 2-填充索引+内容,有空记录 3-仅填充内容,有空记录)
    'SqlString  补充条件
    Dim Rec_Combo As ADODB.Recordset              '填充属性
    Dim Rec_FillText As ADODB.Recordset           '填充内容
    Dim ci As ComboItem
    Dim jsqte As Integer                          '临时计数器
    Dim Sql As String
    Combote.ComboItems.Clear
    jsqte = 1
  
    '填充列表框内容
    Set Rec_Combo = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM Xt_ImageCombo WHERE combo_code='" + Trim(ComboCode) + "'")
    
    With Rec_Combo
        Combote.Locked = True
        If AddType = 2 Or AddType = 3 Then
            Set ci = Combote.ComboItems.Add(, "@")
            jsqte = jsqte + 1
        End If
        Sql = Trim(.Fields("Sql_String")) & SqlString
        Set Rec_FillText = Cw_DataEnvi.DataConnect.Execute(Sql)
        
        Do While Not Rec_FillText.EOF
            Select Case AddType
                Case 0, 2                              '填充索引+内容
                    Set ci = Combote.ComboItems.Add(, "@" + Trim(Rec_FillText.Fields(Trim(.Fields("ItemKey")))), Trim(Rec_FillText.Fields(Trim(.Fields("ItemKey")))) + " " + Trim(Rec_FillText.Fields(Trim(.Fields("ItemText")))))
                Case 1, 3                              '仅填充记录内容
                    Set ci = Combote.ComboItems.Add(, "@" + Trim(Rec_FillText.Fields(Trim(.Fields("ItemKey")))), Trim(Rec_FillText.Fields(Trim(.Fields("ItemText")))))
            End Select
            jsqte = jsqte + 1
            Rec_FillText.MoveNext
        Loop
        If Combote.ComboItems.Count <> 0 Then
            Combote.ComboItems.Item(1).Selected = True
        End If
    End With

End Function

Public Sub CmdUP(CzxsGrid As vsFlexGrid) '向上移动网格中数据的上、下行序
    Dim Temp As String
    Dim i As Long
    With CzxsGrid
        For i = .FixedCols To .Cols - 1
            Temp = .TextMatrix(.Row - 1, i)
            .TextMatrix(.Row - 1, i) = .TextMatrix(.Row, i)
            .TextMatrix(.Row, i) = Temp
        Next
        .Row = .Row - 1
    End With
End Sub

Public Sub CmdDown(CzxsGrid As vsFlexGrid)    '向下移动网格中数据的上、下行序
    Dim Temp As String
    Dim i As Long
    With CzxsGrid
        For i = .FixedCols To .Cols - 1
            Temp = .TextMatrix(.Row + 1, i)
            .TextMatrix(.Row + 1, i) = .TextMatrix(.Row, i)
            .TextMatrix(.Row, i) = Temp
        Next
        .Row = .Row + 1
    End With
End Sub

Public Function StopDelItem(ItemId As Integer, FieldName As String, ChName As String, OpeStatus As String, SortId As String) As Boolean
    '停用、删除项目必须符合以下条件，
    'itemid--项目编号  FieldName--项目字段名  ChName--项目名称  OpeStatus--操作状态（停用、删除） SortId--工资类别
    Dim Rsc As New ADODB.Recordset
    Dim Sql As String
       
    With Rsc
        If LCase(Trim(FieldName)) = "tax" Or LCase(Trim(FieldName)) = "paywage" Or LCase(Trim(FieldName)) = "taxitem" Then
            If .State = 1 Then .Close
            .Open "SELECT * FROM PM_Sort WHERE SortId='" & SortId & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            If Not .EOF Then
               If !DeductTax = True Or (!AdmDeductTax = True And LCase(Trim(FieldName)) = "taxitem") Then
                   Call Xtxxts("本工资类别是扣税类别，不能删除“" & ChName & "”!", 0, 1)
                   StopDelItem = False
                   Exit Function
               End If
            End If
        End If
        
       '没有用在公式的字段中
        If .State = 1 Then .Close
        Sql = "SELECT * FROM PM_Formula WHERE ltrim(rtrim(FieldName)) ='" & _
             FieldName & "' AND sortid='" & SortId & "'"
        .Open Sql, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        If Not .EOF Then
            Call Xtxxts("公式的计算字段使用了“" & ChName & "”，不能" & OpeStatus & "!", 0, 1)
            StopDelItem = False
            Exit Function
        End If
        '没有用在公式的内容中
        If .State = 1 Then .Close
        Sql = "SELECT * FROM PM_Formula WHERE charindex('" & FieldName & _
            "',Fcontent)<>0 AND sortid='" & SortId & "'"
        .Open Sql, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        If Not .EOF Then
            Call Xtxxts("公式内容使用了“" & ChName & "”，不能" & OpeStatus & "!", 0, 1)
            StopDelItem = False
            Exit Function
        End If
        '没有用在公式的限定条件中
        If .State = 1 Then .Close
        Sql = "SELECT * FROM PM_Formula WHERE charindex('" & FieldName & _
              "',FLimit)<>0 AND sortid='" & SortId & "'"
        .Open Sql, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        If Not .EOF Then
            Call Xtxxts("公式的限定条件使用了“" & ChName & "”，不能" & OpeStatus & "!", 0, 1)
            StopDelItem = False
            Exit Function
        End If
        '没有用在标准表的字段中
        If .State = 1 Then .Close
        Sql = "SELECT * FROM PM_StandTbl WHERE ltrim(rtrim(BzbResuItem))='" & _
              FieldName & "' AND sortid='" & SortId & "'"
        .Open Sql, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        If Not .EOF Then
            Call Xtxxts("标准表的结果项目使用了“" & ChName & "”，不能" & OpeStatus & "!", 0, 1)
            StopDelItem = False
            Exit Function
        End If
        '没有用在标准表的限定条件中
        If .State = 1 Then .Close
        Sql = "SELECT * FROM PM_StandTbl WHERE charindex('" & FieldName & _
               "',BzbCond)<>0 AND sortid='" & SortId & "'"
        .Open Sql, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        If Not .EOF Then
            Call Xtxxts("标准表的限定条件使用了“" & ChName & "”，不能" & OpeStatus & "!", 0, 1)
            StopDelItem = False
            Exit Function
        End If
        '没有用在银行代发的项目中
        If .State = 1 Then .Close
        Sql = "SELECT * FROM PM_BankItem WHERE ltrim(rtrim(DataContent))='" & _
              FieldName & "' AND sortid ='" & SortId & "'"
        .Open Sql, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        If Not .EOF Then
            Call Xtxxts("“" & ChName & "”是银行代发文件项目，不能" & OpeStatus & "!", 0, 1)
            StopDelItem = False
            Exit Function
        End If
        '不是报表显示项目
        If .State = 1 Then .Close
        Sql = "SELECT * FROM PM_ReportItem WHERE ltrim(rtrim(FieldName))='" & FieldName & "'" & _
              " AND PmSort='" & SortId & "'"
        .Open Sql, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        If Not .EOF Then
            Call Xtxxts("“" & ChName & "”是报表显示项目，不能" & OpeStatus & "!", 0, 1)
            StopDelItem = False
            Exit Function
        End If
        '没有用在复制数据的清空项中
        If .State = 1 Then .Close
        Sql = "SELECT * FROM PM_SortItem WHERE ItemID=" & ItemId & _
              " AND sortid='" & SortId & "' AND ClearFlag=1"
        .Open Sql, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        If Not .EOF Then
            Call Xtxxts("“" & ChName & "”是清空项目，不能" & OpeStatus & "!", 0, 1)
            StopDelItem = False
            Exit Function
        End If
'
        '不是计算月平均工资项目
        If .State = 1 Then .Close
        Sql = "SELECT * FROM PM_SortItem WHERE ItemID=" & ItemId & _
              " AND sortid='" & SortId & "' AND EndMonth=1"
        .Open Sql, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        If Not .EOF Then
            Call Xtxxts("“" & ChName & "”是计算月平均工资项目，不能" & OpeStatus & "!", 0, 1)
            StopDelItem = False
            Exit Function
        End If
        
    End With
    StopDelItem = True