+

VB开发的ERP系统

                    End If
                Case 4      '卡片编号（终止）
                    If Trim(.LrText(3).Text) <> "" Then
                        Card_Str = Card_Str & " and cardcode<='" & Trim(.LrText(3).Text) & "'"
                    End If
                Case 5      '资产编号
                    If Trim(.LrText(4).Text) <> "" Then
                        Card_Str = Card_Str & " and FACode>='" & (Trim(.LrText(4).Text)) & "'"
                    End If
                Case 6      '资产编号
                    If Trim(.LrText(5).Text) <> "" Then
                        Card_Str = Card_Str & " and FACode<='" & (Trim(.LrText(5).Text)) & "'"
                    End If
                Case 7      '资产类别编号
                    If Trim(.LrText(6).Text) <> "" Then
                        Card_Str = Card_Str & " and FASortCode='" & Trim(.LrText(6).Tag) & "'"
                    End If
                Case 8      '部门编号
                    If Trim(.LrText(7).Text) <> "" Then
                        Card_Str = Card_Str & " and DeptCode='" & Trim(.LrText(7).Tag) & "'"
                    End If
                Case 9      '设备位号
                    If Trim(.LrText(8).Text) <> "" Then
                        Card_Str = Card_Str & " and setlocaNum='" & Trim(.LrText(8).Text) & "'"
                    End If
            End Select
        Next Jsqte
    End With
 
    lng_CurrentRow = CxbbGrid.Row
    
    Sqlstr = "SELECT * From Gdzc_V_CardList " & Card_Str & " ORDER BY CardCode"
    Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With Rec_Query
        CxbbGrid.Rows = CxbbGrid.FixedRows
        CxbbGrid.Rows = CxbbGrid.FixedRows + .RecordCount
        Jsqte = CxbbGrid.FixedRows
        
        Do While Not .EOF
            If Jsqte >= CxbbGrid.Rows Then
                CxbbGrid.AddItem ""
            End If
            
            CxbbGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("CardCode") & "")                                          '卡片编号
            CxbbGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("FASortName") & "")                                        '资产类别
            CxbbGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("FACode") & "")                                            '资产编号
            CxbbGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("FAName") & "")                                            '资产名称
            CxbbGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("SpecificationMode") & "")                                 '规格型号
            CxbbGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("MeasureUnit"))                                            '计量单位
            If Val(.Fields("FAQuantity")) <> 0 Then CxbbGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("FAQuantity"))     '资产数量
            CxbbGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = Trim(.Fields("FAVariName"))                                             '变动方式
            If Val(.Fields("FAValue")) <> 0 Then CxbbGrid.TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)) = Trim(.Fields("FAValue") & "")      '资产原值
            If Val(.Fields("UseYears")) <> 0 Then CxbbGrid.TextMatrix(Jsqte, Sydz("010", GridStr(), Szzls)) = Trim(.Fields("UseYears") & "")    '使用年限
            If Val(.Fields("DeprSum")) <> 0 Then CxbbGrid.TextMatrix(Jsqte, Sydz("011", GridStr(), Szzls)) = Trim(.Fields("DeprSum"))           '累计折旧
            If Val(.Fields("FactValue")) <> 0 Then CxbbGrid.TextMatrix(Jsqte, Sydz("012", GridStr(), Szzls)) = Trim(.Fields("FactValue"))       '净资产
            Select Case .Fields("DeprMethod")                                                                                                   '折旧方法
                Case "01"
                    CxbbGrid.TextMatrix(Jsqte, Sydz("013", GridStr(), Szzls)) = "不计提折旧"
                Case "02"
                    CxbbGrid.TextMatrix(Jsqte, Sydz("013", GridStr(), Szzls)) = "平均年限法(依净资产计提折旧)"
                Case "03"
                    CxbbGrid.TextMatrix(Jsqte, Sydz("013", GridStr(), Szzls)) = "平均年限法(依帐面原值计提折旧)"
                Case "04"
                    CxbbGrid.TextMatrix(Jsqte, Sydz("013", GridStr(), Szzls)) = "工作量法"
                Case "05"
                    CxbbGrid.TextMatrix(Jsqte, Sydz("013", GridStr(), Szzls)) = "固定折旧额折旧法"
                Case "06"
                    CxbbGrid.TextMatrix(Jsqte, Sydz("013", GridStr(), Szzls)) = "年数总和法"
                Case "07"
                    CxbbGrid.TextMatrix(Jsqte, Sydz("013", GridStr(), Szzls)) = "双倍余额法"
            End Select
            CxbbGrid.TextMatrix(Jsqte, Sydz("014", GridStr(), Szzls)) = Format(.Fields("BeginUseDate"), "yyyy-mm-dd")                           '开始使用日期
            CxbbGrid.TextMatrix(Jsqte, Sydz("015", GridStr(), Szzls)) = Trim(.Fields("SetLocaNum") & "")                                        '设备位号
            CxbbGrid.TextMatrix(Jsqte, Sydz("016", GridStr(), Szzls)) = Format(.Fields("WriteDate"), "yyyy-mm-dd")                              '录入日期
            CxbbGrid.RowHeight(Jsqte) = Sjhgd
            .MoveNext
            Jsqte = Jsqte + 1
        Loop
    End With

    If lng_CurrentRow > CxbbGrid.Rows - 1 Then
        lng_CurrentRow = lng_CurrentRow - 1
    End If
   
    If Kpgl_jbcz.str_State = "1" Then
        lng_CurrentRow = CxbbGrid.Rows - 1
    End If
   
    If lng_CurrentRow = 0 Then Exit Sub
    CxbbGrid.TopRow = lng_CurrentRow
    If lng_CurrentRow < CxbbGrid.Rows Then
        CxbbGrid.Select lng_CurrentRow, 1, lng_CurrentRow, CxbbGrid.Cols - 1
    End If
   
    ']以上为用户自定义部分

End Sub

Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
    
    Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
    Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
    Bbxbtgs = 1                                          '报 表 小 标 题 行 数
    Bbbwhgs = 0                                          '报 表 表 尾 行 数
    ReDim Bbxbt(1 To Bbxbtgs)
    ReDim bbxbtzzxs(1 To Bbxbtgs)
    
    If Bbbwhgs <> 0 Then
        ReDim Bbbwh(1 To Bbbwhgs)
        ReDim Bbbwhzzxs(1 To Bbbwhgs)
    End If
    
    Bbzbt = ReportTitle
    Bbxbt(1) = " "
    bbxbtzzxs(1) = 0                                     '报表行组织形式(0-居左 1-居中 2-居右)
    
    Call Scyxsjb(CxbbGrid)                               '生成报表数据
    Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
  
    If Not bbylte Then
        Unload DY_Tybbyldy
    End If

End Sub

'***********************************************************************************
'[>>自定义
'本月是否已经进行计提折旧
Function If_Add() As Boolean
    
    If_Add = False
    Set rstemp = New ADODB.Recordset
    rstemp.Open "select * from Gdzc_card where DeprFlag='1'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    If rstemp.EOF Then
        If_Add = True
    Else
        Tsxx = "固定资产已计提折旧,未执行月末结帐!"
        Call Xtxxts(Tsxx, 0, 4)
        Exit Function
    End If
    rstemp.Close
    Set rstemp = Nothing

End Function

'删除操作
Function Rs_Del()
    
    Dim FAValue_Temp As Double              '修改原资产原值变量
    Dim DeprSum_temp As Double              '修改原累计折旧变量
    Dim DeptCode_temp As String             '部门编号
    Dim FASortCode_temp As String           '资产类别编号
    Dim str As String
    
    '已计提折旧资产不能发生变动
    Set rstemp = New ADODB.Recordset
    rstemp.Open "select * from Gdzc_Variation where FAVariCode='00501' and Cardcode='" & Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    If Not rstemp.EOF Then
        Tsxx = "该资产卡片已经计提折旧,不能删除!"
        Call Xtxxts(Tsxx, 0, 4)
        Exit Function
    End If
    rstemp.Close
    Set rstemp = Nothing
    
    '非本会计期间不能进行数据添加、修改、删除操作
    Set rstemp = New ADODB.Recordset
    rstemp.Open "select * from gdzc_card where CardCode='" & Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) & "' and year=" & CInt(Xtyear) & " and period=" & CInt(Xtmm), Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    If rstemp.EOF Then
       Tsxx = "请操作本会计期间数据!"
       Call Xtxxts(Tsxx, 0, 4)
       Exit Function
    End If
    rstemp.Close
    Set rstemp = Nothing
    
    If MsgBox("真的要删除该记录吗?", vbOKCancel + vbDefaultButton2 + vbQuestion, "百利/ERP5.0-固定资产") = vbOK Then
        
        On Error GoTo Cwcl
        Cw_DataEnvi.DataConnect.BeginTrans

        '删除资产卡片
        Set rstemp = New ADODB.Recordset
        rstemp.Open "select * from Gdzc_Card where CardCode='" & Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        If Not rstemp.EOF Then
            FAValue_Temp = rstemp.Fields("FAValue")                                 '借助变量存储修改资产原值
            DeprSum_temp = rstemp.Fields("DeprSum")
            DeptCode_temp = rstemp.Fields("DeptCode")
            FASortCode_temp = rstemp.Fields("FASortCode")
            rstemp.Delete
            rstemp.Update
        Else
            Tsxx = "请操作本会计期间的记录!"
            Call Xtxxts(Tsxx, 0, 4)
            Exit Function
        End If
        rstemp.Close
        Set rstemp = Nothing
        
        '删除工作量表
        Set rstemp = New ADODB.Recordset
        With rstemp
            .Open "select * from Gdzc_jobquantity where CardCode='" & Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            If Not .EOF Then
                .Delete
                .Update
            End If
        End With
        rstemp.Close
        Set rstemp = Nothing
        
        '删除会计明细表记录
        Set rstemp = New ADODB.Recordset
        With rstemp
            .Open "select * from Gdzc_DetailedForm where CardCode='" & Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            .Delete
            .Update
        End With
        rstemp.Close
        Set rstemp = Nothing
        
        '修改资产汇总表记录
        Set rstemp = New ADODB.Recordset
        str = "select * from Gdzc_Total where DeptCode='" & DeptCode_temp & "' and FASortCode='" & FASortCode_temp & "'"
        rstemp.Open str, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        With rstemp
            If Not .EOF Then
                If Val(.Fields("FAValueEndM")) = Val(FAValue_Temp) Then
                    .Delete
                    .Update
                Else
                    .Fields("FAValueEndM") = CCur(Format(Val(.Fields("FAValueEndM")) - FAValue_Temp, "##0.00"))       '月末原值
                    .Fields("DeprSumEndM") = CCur(Val(.Fields("DeprSumEndM")) - DeprSum_temp)  '月末累计折旧
                    .Fields("FAValueInM") = CCur(Val(.Fields("FAValueInM")) - FAValue_Temp)     '本期增加原值
                    .Fields("DeprSumInM") = CCur(Val(.Fields("DeprSumInM")) - DeprSum_temp)      '本期累计折旧增加
                    .Update
                End If
            End If
        End With
        rstemp.Close
        Set rstemp = Nothing
        
        '删除资产变动单据表
        Set rstemp = New ADODB.Recordset
        With rstemp
            .Open "Select * from Gdzc_Variation where CardCode='" & Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            While Not .EOF
                .Delete
                .Update
                .MoveNext
            Wend
        End With
        rstemp.Close
        Set rstemp = Nothing
        
        '判断并修改自定义属性表
        Set rstemp = New ADODB.Recordset
        rstemp.Open "select * from gdzc_Custom where FieldState='1'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        While Not rstemp.EOF
            Set rs = New ADODB.Recordset
            rs.Open "select * from gdzc_card where convert(char(20)," & Trim(rstemp!FieldCode) & ")<>''", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            If rs.EOF Then
                rstemp!WhetherNull = False
                rstemp.Update
            End If
            rs.Close
            Set rs = Nothing
            
            rstemp.MoveNext
        Wend
        rstemp.Close
        Set rstemp = Nothing
        
        Cw_DataEnvi.DataConnect.CommitTrans
        Call Sub_Query
                
        Exit Function
    Else
        Exit Function
    End If
Cwcl:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "删除出错，系统自动返回删除前状态！"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Function
    
End Function

'判断选中记录是否可以操作
Function Edit_Bit() As Boolean
    
    Edit_Bit = False
    
    Set rstemp = New ADODB.Recordset
    rstemp.Open "select * from gdZc_card where cardCode='" & Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) & "' and year=" & Xtyear & " and period=" & Xtmm, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    If Not rstemp.EOF Then
        Tsxx = "本会计期间录入卡片只能进行修改或删除!     "
        Call Xtxxts(Tsxx, 0, 4)
        Exit Function
    End If
    rstemp.Close
    Set rstemp = Nothing
    
    Set rstemp = Cw_DataEnvi.DataConnect.Execute("select top 1 * from gy_kjrlb where gdzcjzbz='0'")
    If Not rstemp.EOF Then
        If Val(rstemp!KjYear) <> Val(Xtyear) Or Val(rstemp!Period) <> Val(Xtmm) Then
            Tsxx = "非当前会计期间不能进行此操作!"
            Call Xtxxts(Tsxx, 0, 4)
            Exit Function
        End If
    End If
    rstemp.Close
    Set rstemp = Nothing
    
    Edit_Bit = True
    
End Function
'<<]
'***********************************************************************************