-

VB开发的ERP系统

Attribute VB_Name = "XtsyModule"
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long


'系统私有模块用来放置一些子系统独有的过程与函数
Public str_Code As String                               '存储列内容参数
Public Const MoneyType = 0
Public Const NumberType = 1
Public Const ValueType = 2

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 Function HaveChinese(sTest As String) As Boolean
    If LenB(StrConv(Trim(sTest), vbFromUnicode)) <> Len(Trim(sTest)) Then
        HaveChinese = True
    Else
        HaveChinese = False
    End If
End Function


Public Function Fun_ConvDec(DataType As Variant, CheckData As Variant) As String
    If IsMissing(CheckData) Or IsNull(CheckData) Then
        CheckData = 0
    End If
    Select Case DataType
        Case 0                                      '金额类型
            Fun_ConvDec = Format(CheckData, Fun_ConvStr(Xtjezws - Xtjexsws, Xtjexsws))
        Case 1                                      '数量类型
            Fun_ConvDec = Format(CheckData, Fun_ConvStr(Xtslzws - Xtslxsws, Xtslxsws))
        Case 2                                      '单价类型
            Fun_ConvDec = Format(CheckData, Fun_ConvStr(Xtdjzws - Xtdjxsws, Xtdjxsws))
    End Select
    
End Function

Private Function Fun_ConvStr(IntNum As Integer, DecNum As Integer) As String
    Dim FormatStr As String
    For i = 1 To IIf(IntNum - 1 >= 1, IntNum - 1, 1)
        FormatStr = FormatStr + "#"
    Next i
    FormatStr = FormatStr + "0."

    For i = 1 To DecNum
        FormatStr = FormatStr + "0"
    Next i
    Fun_ConvStr = FormatStr
End Function

Public Function Fun_Ceiling(CeilingData As Double) As Double
    If Int(CeilingData) = CeilingData Then
        Fun_Ceiling = CeilingData
    Else
        Fun_Ceiling = Int(CeilingData) + 1
    End If
End Function
'Functoin :返回一个月的起始日期
Public Function Fn_GetMonthBeginDate(sYear As Integer, sMonth As Integer) As String
    Dim sBeginDate As String, Rect As New ADODB.Recordset, Sql As String
    
    Sql = "Select * from gy_kjrlb Where kjYear='" & sYear & "' And Period='" & sMonth & "'"
    Set Rect = Cw_DataEnvi.DataConnect.Execute(Sql)
    If Not Rect.EOF Then
        Fn_GetMonthBeginDate = Format(Rect!Qsrq, "yyyy-mm-dd")
    Else
        sBeginDate = Str(sYear) + "-" + Str(sMonth) + "-01"
        Fn_GetMonthBeginDate = Format(sBeginDate, "yyyy-mm-dd")
    End If

    
    Set Rect = Nothing
End Function
'Functoin :返回一个月的结束日期
Public Function Fn_GetMonthEndDate(sYear As Integer, sMonth As Integer) As String
    Dim sEndDate As String, Rect As New ADODB.Recordset, Sql As String
    
    Sql = "Select * from gy_kjrlb Where kjYear='" & sYear & "' And Period='" & sMonth & "'"
    Set Rect = Cw_DataEnvi.DataConnect.Execute(Sql)
    If Not Rect.EOF Then
        Fn_GetMonthEndDate = Format(Rect!Zzrq, "yyyy-mm-dd")
        
    Else
        If sMonth + 1 > 12 Then
            sEndDate = Str(sYear) + "-12-31"
        Else
            sEndDate = Str(sYear) + Str(sMonth + 1) + "-01"
            sEndDate = Format(CDate(sEndDate) - 1, "yyyy-mm-dd")
        End If
        Fn_GetMonthEndDate = Format(sEndDate, "yyyy-mm-dd")
    End If
    
Set Rect = Nothing
End Function
'取得年开始日期
Public Function Fn_GetYearBeginDate(sYear As Integer) As String
    Dim sEndDate As String, Rect As New ADODB.Recordset, Sql As String
    
    Sql = "Select Qsrq  From gy_kjrlb  Where kjYear='" & sYear & "' And Period=1 "
    Set Rect = Cw_DataEnvi.DataConnect.Execute(Sql)
    If Not Rect.EOF Then
        Fn_GetYearBeginDate = Format(Trim(Rect!Qsrq & ""), "yyyy-mm-dd")
    Else
        Fn_GetYearBeginDate = Format(Trim(Str(sYear)) + "-01-01", "yyyy-mm-dd")
    End If
    Set Rect = Nothing
End Function

'判断当前用户是否对某个部门有操作权限
Public Function Fn_DeptQueryRight(Czybm As String, DeptCode As String) As Boolean
    Dim Rectemp As New ADODB.Recordset, Sqlstr As String
    
    Sqlstr = "Select Admin From MRP_DeptAdmin Where  Czybm='" & Czybm & "' "
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If Not Rectemp.EOF Then
        If Rectemp.Fields("Admin") = True Then
            Fn_DeptQueryRight = True: Set Rectemp = Nothing: Exit Function
        End If
    End If
    
    Sqlstr = "Select Admin From MRP_DeptAdmin Where DeptCode='" & DeptCode & "' And Czybm='" & Czybm & "' "
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If Rectemp.EOF Then
        Fn_DeptQueryRight = False
    Else
        Fn_DeptQueryRight = True
    End If
    Set Rectemp = Nothing:
End Function