˪

VB开发的ERP系统

            Call Xtxxts(Tsxx, 0, 4)
            Exit Sub
        Else
            '调入单据处理窗体
            With FK_FrmNoteIn
                
                '填充查询单据标识
                XT_BillID = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
                Xtcdcsfz = Str_QueryCondi
                If Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("003", GridStr(), Szzls))) = "期初" Then
                    TranPara = "期初"
                Else
                    TranPara = ""
                End If
                '设置单据处理为列表查询(修改)状态
                Xtcdcs = "2"
                .Show 1
            End With
            
            If Xtfhcs = "1" Then
                Tsxx = "应付票据发生变化,是否刷新应付票据单列表?"
                yhAnswer = Xtxxts(Tsxx, 2, 2)
                If yhAnswer = 1 Then
                    Xt_Wait.Show
                    Xt_Wait.Refresh
                    
                    '加快显示速度
                    CxbbGrid.Redraw = False
                    '生成查询结果
                    Call Sub_Query(1)
   
                    CxbbGrid.Redraw = True
    
                    Xt_Wait.Hide
                End If
            End If
        End If
    End With

End Sub

Private Sub Sub_AddBill()                                              '新增单据
    
    With FK_FrmNoteIn
       
        '设置单据处理为填制单据状态
        Xtcdcs = "1"
         
        .Show 1
    End With
       
    If Xtfhcs = "1" Then
        Tsxx = "应付票据发生变化,是否刷新应付票据列表?"
        yhAnswer = Xtxxts(Tsxx, 2, 2)
        
        If yhAnswer = 1 Then
            Xt_Wait.Show
            Xt_Wait.Refresh
            
            '加快显示速度
            CxbbGrid.Redraw = False
            
            '生成查询结果
            Call Sub_Query(1)
            
            CxbbGrid.Redraw = True
            Xt_Wait.Hide
        End If
    End If
   
End Sub

Private Sub Sub_DeleteBill()                                            '删除选中当前单据
    
    Dim YAnswer As Integer
    Dim Lng_BillID As Long           '单据标识
    
    '记录行总数与固定行数相等则退出
    If CxbbGrid.Rows = CxbbGrid.FixedRows Then Exit Sub

    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
        Exit Sub
    End If
  
    Tsxx = "请确认是否删除当前应付票据?"
    yhAnswer = Xtxxts(Tsxx, 2, 2)
  
    If yhAnswer = 1 Then
  
        '1.判断当前单据是否允许删除
        If Not Fun_AllowDelete Then
            Exit Sub
        End If
  
        '2.删除单据所有内容
        Lng_BillID = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
      
        On Error GoTo Swcwcl
    
        Cw_DataEnvi.DataConnect.BeginTrans
        Cw_DataEnvi.DataConnect.Execute ("Delete RP_Note Where NoteID=" & Lng_BillID)        '删除单据内容
        Cw_DataEnvi.DataConnect.CommitTrans
        
        '汇总应付票据金额
        YbSsTotal = YbSsTotal - CxbbGrid.TextMatrix(Jsqte, Sydz("010", GridStr(), Szzls))
        YbInterest = YbInterest - CxbbGrid.TextMatrix(Jsqte, Sydz("011", GridStr(), Szzls))
        BbSsTotal = BbSsTotal - CxbbGrid.TextMatrix(Jsqte, Sydz("013", GridStr(), Szzls))
      
        '删除网格中单据数据
        CxbbGrid.RemoveItem (CxbbGrid.Row)
        
        '刷新合计行
        If YbSsTotal <> 0 Or BbSsTotal <> 0 Then
            CxbbGrid.TextMatrix(CxbbGrid.Rows - 1, Sydz("005", GridStr(), Szzls)) = "  合  计"
            If Str_Foreign <> "" Then
                CxbbGrid.TextMatrix(CxbbGrid.Rows - 1, Sydz("010", GridStr(), Szzls)) = YbSsTotal
                CxbbGrid.TextMatrix(CxbbGrid.Rows - 1, Sydz("011", GridStr(), Szzls)) = YbInterest
            End If
            CxbbGrid.TextMatrix(CxbbGrid.Rows - 1, Sydz("013", GridStr(), Szzls)) = BbSsTotal
        Else
            CxbbGrid.RemoveItem (CxbbGrid.Rows - 1)
        End If
        
    Else
        Exit Sub
    End If
  
    Exit Sub
Swcwcl:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "删除单据过程中出现未知错误,程序自动恢复删除前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Sub
  
End Sub

Private Function Fun_AllowDelete() As Boolean                                        '判断当前单据是否允许删除
  
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    Dim Sqlstr As String                   '查询字符串
    Dim Lng_BillID As Long                 '单据ID
  
    Lng_BillID = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
    Sqlstr = "Select Checker,Fstatus From RP_Note Where NoteID=" & Lng_BillID
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With RecTemp
        If Not .EOF Then
            If Trim(.Fields("Checker") & "") <> "" Then
                Tsxx = "该应付票据已审核确认,不能删除!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            End If
            End If
    End With
    If RecTemp.Fields("Fstatus") <> 9 Then
        Tsxx = "该票据已发生变动，不能删除！"
        Call Xtxxts(Tsxx, 0, 4)
        Exit Function
    End If
    Fun_AllowDelete = True
End Function

'[>>===================以下为根据实际业务需要自定义过程区域=============================<<]

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
Private Function NoteCheck() As Boolean '判断票据是否已经审核并且处于收票状态
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    Dim Lng_BillID As Integer              '单据ID号
    
    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
        Exit Function
    End If
    Lng_BillID = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))

    Sqlstr = "Select Fstatus,Checker From Rp_Note Where NoteID='" & Lng_BillID & "'"
    
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    '如果票据不是收票状态，不能执行弃审、背书、贴现等操作
    If RecTemp.Fields("Fstatus") <> 9 Then
        Tsxx = "该票据已经发生变动，不能执行此操作！"
        Call Xtxxts(Tsxx, 0, 4)
        NoteCheck = False
        Exit Function
    End If
    If Trim(RecTemp.Fields("Checker") & "") = "" Then
        Tsxx = "该单据没有审核，不能执行此操作!"
        Call Xtxxts(Tsxx, 0, 4)
        NoteCheck = False
        Exit Function
    End If
    NoteCheck = True
End Function
Private Sub Sub_NoteDiscount()  '贴现，'要求票状为收票状态,且单据已审核
    If NoteCheck = True Then
        XT_BillID = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
        Note_FrmNoteDiscount.Show 1
        If Xtfhcs = "1" Then  '贴现成功'在应付票据中写贴现标志
            Cw_DataEnvi.DataConnect.Execute ("Update RP_Note set Fstatus=3 where NoteID='" & XT_BillID & "'")
            CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("003", GridStr(), Szzls)) = "贴现"                                         '票据状态
        End If
    End If
End Sub

Private Sub Sub_NoteEncash() '兑现,'要求票状为收票状态,且单据已审核
    If NoteCheck = True Then
        XT_BillID = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
        FK_FrmNoteEncash.Show 1
        If Xtfhcs = "1" Then  '付款成功'在应付票据中写付款标志
            Cw_DataEnvi.DataConnect.Execute ("Update RP_Note set Fstatus=4 where NoteID='" & XT_BillID & "'")
            CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("003", GridStr(), Szzls)) = "付款"                                         '票据状态
        End If
    End If
End Sub
Private Sub Sub_CheckBill()             '审 核
    Dim RecTemp As New ADODB.Recordset
    
    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
        Exit Sub
    End If
    XT_BillID = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
    
    If Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("003", GridStr(), Szzls))) = "期初" Then   '期初应付票据不必登记应付帐
        Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Select Checker From RP_Note Where NoteID=" & XT_BillID)
        If Not RecTemp.EOF Then
            If Trim(RecTemp.Fields("Checker") & "") <> "" Then
                Tsxx = "该单据已审核,不需再次审核!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Sub
            Else
                '将单据写入审核标识
                Cw_DataEnvi.DataConnect.Execute ("Update Rp_Note Set Checker='" & Xtczy & "' Where NoteID='" & XT_BillID & "'")
                '显示系统操作员
                CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("018", GridStr(), Szzls)) = Xtczy                                        '票据状态
            End If
        End If
    Else
        '加记帐过程的过程
        If Fun_CheckNote(XT_BillID) = True Then          '审核过帐
    
            '将单据写入审核标识
            Cw_DataEnvi.DataConnect.Execute ("Update Rp_Note Set Checker='" & Xtczy & "' Where NoteID='" & XT_BillID & "'")
    
            '显示系统操作员
            CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("018", GridStr(), Szzls)) = Xtczy                                        '票据状态
        End If
    End If
End Sub