VB开发的ERP系统

            
        '2.放置行处理程序(当数据行通过有效性判断)

        '以上为自定义部分<<]
    End With    'WglrGrid

    '如果此行通过行有效性判断则加锁,直至此行数据再次发生变化
    Sjhzyxxpd = True
    Hyxxpdlock = True
    Exit Function

Lrcwcl:      '录入错误处理
    With WglrGrid
  
        '给出错误提示信息
        Call Xtxxts(Tsxx, 0, 1)
      
        '返回网格错误位置 (ChangeLock避免再次引发RowColChange有效性判断), 装入录入载体
        Changelock = True
        .Select Yxxpdh, Lrywlz
        Changelock = False
        Call xswbk
    
        '函数返回False
        Sjhzyxxpd = False
        Exit Function
    End With

End Function

Private Sub Sub_AddBill()                                                '新增一张单据
    
    Dim RecTemp As New ADODB.Recordset            '临时使用动态集
    Dim jsqte As Long                             '临时计数器
   
    '设置操作状态为新增(Fixed)
    Lab_OperStatus.Caption = "2"
       
    '设置工具条状态(Fixed)
    Call Sub_OperStatus("20")
   
    '清空VouchID(Fixed)
    Lab_BillId.Caption = ""
      
    '录入文本框清除内容
    TextChangeLock = True
    
    For jsqte = Max_Text_Index To 0 Step -1
        LrText(jsqte).Tag = ""
        LrText(jsqte).Text = ""
    Next jsqte
   
    '[>>显示制单人,清空审核人,此处还可以设置录入默认值如自动生成单据号、默认单据录入日期注意加锁
    LrText(6).Text = Xtczy
    LrText(7).Text = ""
    
    '读取最新的单据编码
    LrText(1).Text = CreatBillCode(BillCode, False)
    TextChangeLock = False
      
    '设置订单日期默认为系统业务日期
    TextChangeLock = True
    LrText(0).Text = Xtrq
    TextChangeLock = False
   
    '<<]
   
    '重置网格(Fixed)
    With WglrGrid
        .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
        For jsqte = .FixedRows To .Rows - 1
            .RowHeight(jsqte) = Sjhgd
        Next jsqte
        WglrGrid.Clear 1
        Changelock = True
        .Select .FixedRows, Qslz
        Changelock = False
    End With
   
    '计算合计数据(清零)(Fixed)
    For jsqte = Qslz To WglrGrid.Cols - 1
        Call Sjhj(jsqte)
    Next jsqte
    On Error Resume Next
    
    '让第一个录入项得到焦点(Fixed)
    LrText(0).SetFocus
   
End Sub

Private Sub Sub_EditBill()                                                '修改一张单据
   
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
   
    '非有效单据不予进行修改动作
    If Val(Lab_BillId.Caption) = 0 Then
        Exit Sub
    End If
   
    '判断当前单据是否允许修改
    If Not Fun_AllowEdit Then
        Exit Sub
    End If
   
    '设置操作状态为修改
    Lab_OperStatus.Caption = "3"
   
    '设置工具条状态
    Call Sub_OperStatus("30")
        
    '显示制单人
    LrText(6).Text = Xtczy
   
End Sub

Private Sub Sub_DeleteBill()                                               '删除当前单据
    Dim YAnswer As Integer               '确认是否删除当前单据
    Dim jsqte As Long                    '临时使用计数器
    Dim RecTemp As New ADODB.Recordset
    Dim tempstr As String
    '非有效单据不予进行删除动作
    If Val(Lab_BillId.Caption) = 0 Then
        Exit Sub
    End If
   
    Tsxx = "请确认是否删除当前单据?"
    YAnswer = Xtxxts(Tsxx, 2, 2)
   
    If YAnswer = 1 Then
   
        '判断当前单据是否允许删除
        If Not Fun_AllowEdit Then
            Exit Sub
        End If
      
        '进行事务处理
        On Error GoTo Swcwcl
        tempstr = "SELECT * From Cg_InvoiceMain WHERE  InvoiceMainID IN  (SELECT NULLIF (InvoiceMainID, 0) From Kf_BalanceRelation  Where BalanceMainId = " & Val(Lab_BillId.Caption) & ") and apbookflag=1"
        Set RecTemp = Cw_DataEnvi.DataConnect.Execute(tempstr)
        If RecTemp.RecordCount <> 0 Then
            Tsxx = "与该单据相关联的采购发票已过帐" & Chr(13) & "不能删除该结算单!"
            Call Xtxxts(Tsxx, 0, 4)
            Exit Sub
        End If
        RecTemp.Close
        Cw_DataEnvi.DataConnect.BeginTrans
        Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Kf_Sp_BalanceDelete  " & Val(Lab_BillId.Caption))
        If RecTemp.RecordCount <> 0 Then
            If RecTemp.Fields(0).Value = 0 Then
                    Tsxx = "与该单据相关联的材料入库单已审核" & Chr(13) & "或已记账确认,不能删除该结算单!"
                    Call Xtxxts(Tsxx, 0, 4)
                    Cw_DataEnvi.DataConnect.CommitTrans
                    Exit Sub
            End If
        Else
            Tsxx = "该删除功能出现错误!"
            Call Xtxxts(Tsxx, 0, 4)
            Cw_DataEnvi.DataConnect.CommitTrans
            Exit Sub
        End If
   
        
        '1.删除单据所有内容
        Cw_DataEnvi.DataConnect.CommitTrans
      
        '标识单据发生改动
        Bln_BillChange = True
    Rec_Query.Requery
    
        '单据ID置0
        Lab_BillId.Caption = 0
    Else
        Exit Sub
    End If
    
   '删除单据后重置状态
    '1.显示下一张单据
    Call Sub_next
        
    '2.如果无下一张单据则搜索上一张单据
    If Val(Lab_BillId.Caption) = 0 Then
        Call Sub_Prev
    End If
        
    '3.如无单据则置单据为空状态
    If Val(Lab_BillId.Caption) = 0 Then
        '清除录入文本框
        For jsqte = Max_Text_Index To 0 Step -1
            LrText(jsqte).Tag = ""
            LrText(jsqte).Text = ""
        Next jsqte
    
        '重置网格(Fixed)
        With WglrGrid
            .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
            For jsqte = .FixedRows To .Rows - 1
                .RowHeight(jsqte) = Sjhgd
            Next jsqte
            WglrGrid.Clear 1
            Changelock = True
            .Select .FixedRows, Qslz
            Changelock = False
        End With
    
        '计算合计数据(清零)(Fixed)
        For jsqte = Qslz To WglrGrid.Cols - 1
            Call Sjhj(jsqte)
        Next jsqte
    
        '设置操作状态为浏览
        Lab_OperStatus = "1"
        Call Sub_OperStatus("10")
    End If

    Rec_Query.Requery
    Rec_Query.Find "BalanceMainId =" & Val(Lab_BillId.Caption)
    Exit Sub
   
Swcwcl:          '单据删除时出现错误
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "单据删除过程中出现未知错误,程序自动恢复保存前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Sub

End Sub

Private Sub Sub_AbandonBill()                                              '放弃对当前单据的操作
 
    Dim jsqte As Long                    '临时使用计数器
  
    '先关闭录入载体(Fixed)
    Changelock = True
    Valilock = True
    Call Ycwbk
    Changelock = False
    Valilock = False

    '如果单据有效则重新显示当前单据,置单据为空状态
    If Not Rec_Query.EOF Then
        Lab_BillId.Caption = Rec_Query.Fields("BalanceMainId")
        Call Sub_ShowBill
    Else
        '单据ID置为0
        Lab_BillId.Caption = 0
     
        '清除录入文本框
        For jsqte = Max_Text_Index To 0 Step -1
            LrText(jsqte).Tag = ""
            LrText(jsqte).Text = ""
        Next jsqte

        '重置网格(Fixed)
        With WglrGrid
            .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
            For jsqte = .FixedRows To .Rows - 1
                .RowHeight(jsqte) = Sjhgd
            Next jsqte

            WglrGrid.Clear 1
            Changelock = True
            .Select .FixedRows, Qslz
            Changelock = False
        End With

        '计算合计数据(清零)(Fixed)
        For jsqte = Qslz To WglrGrid.Cols - 1
            Call Sjhj(jsqte)
        Next jsqte
    End If
    
    '设置操作状态为浏览
    Lab_OperStatus = "1"
    Call Sub_OperStatus("10")

End Sub

'选择首张,上张,下张,末张(此4个过程只需用您的单据ID字段名替换"BalanceMainId"即可)
Private Sub Sub_First()             '首 张
    
    With Rec_Query
        If .RecordCount = 0 Then
            Exit Sub
        End If
        .MoveFirst
        Lab_BillId.Caption = .Fields("BalanceMainId")
        Call Sub_ShowBill
    End With

End Sub

Private Sub Sub_Prev()             '上 张
    
    With Rec_Query
        If .RecordCount = 0 Then
            Exit Sub
        End If
        If Not .BOF Then
            .MovePrevious
        End If
        If Not .BOF Then
            Lab_BillId.Caption = .Fields("BalanceMainId")
        Else
            .MoveNext
        End If
        Call Sub_ShowBill
    End With

End Sub

Private Sub Sub_next()             '下 张
    With Rec_Query
        If .RecordCount = 0 Then
            Exit Sub
        End If
        If Not .EOF Then
            .MoveNext
        End If
        If Not .EOF Then
            Lab_BillId.Caption = .Fields("BalanceMainId")
        Else
            .MovePrevious
            Lab_BillId.Caption = .Fields("BalanceMainId")
        End If
        Call Sub_ShowBill
    End With

End Sub

Private Sub Sub_Last()              '末 张
    
    With Rec_Query
        If .RecordCount = 0 Then
            Exit Sub
        End If