VB开发的ERP系统

    
End Sub

Private Sub Form_Unload(Cancel As Integer)             '窗体卸载

    Set Cxnrrec = Nothing
    Set Rec_CodeSet = Nothing
    Unload Dyymctbl
   
End Sub

Private Function Bclrsj() As Boolean                   '判断录入数据有效性,并保存数据
    Dim Rec_EditBill As New ADODB.Recordset    '修改数据
    Dim jsqte As Integer
  
    '对文本框录入内容进行为零和为空判断(固定不变)
    
        For jsqte = 0 To Max_Text_Index
            If Textint(jsqte, 8) = 1 Then     '字段不能为空
                If Len(Trim(LrText(jsqte).Text)) = 0 Then
                    Tsxx = Textstr(jsqte, 7) & "不能为空!"
                    Call Xtxxts(Tsxx, 0, 1)
                    LrText(jsqte).SetFocus
                    Bclrsj = False
                    Exit Function
                End If
            Else
                If Textint(jsqte, 8) = 2 Then   '字段不能为零
                    If S2N(Trim(LrText(jsqte).Text)) = 0 Then
                        Tsxx = Textstr(jsqte, 7) & "不能为零!"
                        Call Xtxxts(Tsxx, 0, 1)
                        LrText(jsqte).SetFocus
                        Bclrsj = False
                        Exit Function
                    End If
                End If
            End If
        Next jsqte
    
        '对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
        For jsqte = 0 To Max_Text_Index
            If Textint(jsqte, 9) = 0 Or Textint(jsqte, 9) = 2 Then
                If Not TextYxxpd(jsqte) Then
                    Exit Function
                End If
            End If
        Next jsqte
        '反馈日期不能小于计划日期
        If Trim(LrText(8).Text) <> "" Then
            If Trim(LrText(8).Text) < Trim(LrText(2).Text) Then
                Tsxx = "反馈日期不能小于计划日期!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(8).SetFocus
                Bclrsj = False
                Exit Function
            End If
        End If
    With Rec_CodeSet
        If Lrzt = 1 Then  '增 加
        

            
    
            '判断记录内容无误后,将记录内容写入数据表
            On Error GoTo Swcwcl
    
            Cw_DataEnvi.DataConnect.BeginTrans
                If .State = 1 Then .Close
                .Open "SELECT * FROM Cg_PlanFeedback WHERE 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
                
                LrText(0).Text = CreatBillCode("1110", True)
                .AddNew
                .Fields("PlanFeedbackID") = CreatBillID("1101")         '反馈单ID号
                .Fields("PlanFeedbackNum") = Trim(LrText(0).Text)       '反馈单号
                .Fields("PurPlanMainID") = Trim(LrText(1).Tag)          '计划ID号
                .Fields("PurPlanNum") = Trim(LrText(1).Text)            '计划单号
                .Fields("PlanDate") = CDate(LrText(2).Text)             '计划日期
                If Trim(LrText(3).Text) <> "" Then
                    .Fields("PlanDept") = Trim(LrText(3).Tag)           '计划部门
                End If
                .Fields("Buyer") = Trim(LrText(4).Tag)                  '采购员
                .Fields("FinishCircs") = Trim(LrText(5).Text)           '完成情况
                .Fields("ExistIssue") = Trim(LrText(6).Text)            '存在问题
                .Fields("SettleWay") = Trim(LrText(7).Text)             '处理办法
                If Trim(LrText(8).Text) <> "" Then
                    .Fields("PlanFeedbackDate") = CDate(LrText(8).Text) '反馈日期
                End If
                .Fields("Remark") = Trim(LrText(9).Text)                '备注
            .Update
            
            Cw_DataEnvi.DataConnect.CommitTrans
   
            '将记录加入网格
            Sqlstr = "SELECT * FROM Cg_V_PlanFeedBack WHERE PlanFeedbackNum= '" + Trim(LrText(0).Text) + "'"
            Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            
            With CzxsGrid
                .AddItem ""
                .RowHeight(.Rows - 1) = Sjhgd
                .Select .Rows - 1, Qslz
                Call Jltcwg(Cxnrrec, .Rows - 1)
            End With
   
            Tsxx = "保存完毕!"
            Call Xtxxts(Tsxx, 0, 4)
            
            Call Cshlrxx(1)
            LrText(1).SetFocus
   
            '将网格按编码排序
            With CzxsGrid
                .Col = Sydz("001", GridStr(), Szzls)
                CzxsGrid.Sort = flexSortStringAscending
            End With
            '<<]
    
        Else  '否则为修改记录
 
            
        
            On Error GoTo Swcwcl
        
            Cw_DataEnvi.DataConnect.BeginTrans
         
            If Rec_EditBill.State = 1 Then Rec_EditBill.Close
            Rec_EditBill.Open "SELECT * FROM Cg_PlanFeedback WHERE PlanFeedbackNum= '" + Trim(LrText(0).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
             
            If Not Rec_EditBill.EOF Then
                Rec_EditBill.Fields("PurPlanMainID") = Trim(LrText(1).Tag)              '计划ID号
                Rec_EditBill.Fields("PurPlanNum") = Trim(LrText(1).Text)                '计划单号
                Rec_EditBill.Fields("PlanDate") = CDate(LrText(2).Text)                 '计划日期
                If Trim(LrText(3).Text) <> "" Then
                    Rec_EditBill.Fields("PlanDept") = Trim(LrText(3).Tag)               '计划部门
                Else
                    Rec_EditBill.Fields("PlanDept") = Null
                End If
                Rec_EditBill.Fields("Buyer") = Trim(LrText(4).Tag)                      '采购员
                Rec_EditBill.Fields("FinishCircs") = Trim(LrText(5).Text)               '完成情况
                Rec_EditBill.Fields("ExistIssue") = Trim(LrText(6).Text)                '存在问题
                Rec_EditBill.Fields("SettleWay") = Trim(LrText(7).Text)                 '处理办法
                If Trim(LrText(8).Text) <> "" Then
                    Rec_EditBill.Fields("PlanFeedbackDate") = CDate(LrText(8).Text)     '反馈日期
                Else
                    Rec_EditBill.Fields("PlanFeedbackDate") = Null
                End If
                Rec_EditBill.Fields("Remark") = Trim(LrText(9).Text)                    '备注
                Rec_EditBill.Update
               
            End If
            
            Cw_DataEnvi.DataConnect.CommitTrans
            
            '刷新当前网格
            Sqlstr = "SELECT * FROM Cg_V_PlanFeedBack WHERE PlanFeedbackNum= '" + Trim(LrText(0).Text) + "'"
            Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            
            If Not Cxnrrec.EOF Then
                With CzxsGrid
                    Call Jltcwg(Cxnrrec, .Row)
                End With
            Else
                Tsxx = "该记录已经被其他人删除,请刷新当前数据!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            End If
   
        End If
     
        '保存记录成功,函数返回真值
        Bclrsj = True
        Exit Function
    End With
 
Swcwcl:

    Cw_DataEnvi.DataConnect.RollbackTrans
    
    Tsxx = "存盘过程中出现错误,程序自动恢复保存前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    
    Exit Function
     
End Function

Private Function Cshlrxx(lrztxx As Integer) As Boolean              '初始化录入字段信息

    TextChangeLock = True       '关闭文本框Chang事件
    LrText(0).Enabled = False
    
    If lrztxx = 1 Then
    
        '增加新记录时将文本框清空
        For jsqte = 1 To Max_Text_Index
            If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
                LrText(jsqte).Text = ""
                LrText(jsqte).Tag = ""
            End If
            TextValiJudgeLock(jsqte) = True
        Next jsqte
        
        '[>>
        LrText(0).Text = CreatBillCode("1110", False)
        LrText(2).Enabled = False
        LrText(3).Enabled = False
        LrText(4).Enabled = False
        LrText(8).Text = Format(Xtrq, "yyyy-mm-dd")
        
        '在此处可添加新增记录时初始化设置
        '<<]
    Else
    
        '修改记录时根据记录关键字(编码)从数据表中读入其他字段内容
        With RecTemp
        
            Sqlstr = "SELECT * FROM Cg_V_PlanFeedBack Where PlanFeedbackNum='" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) & "'"
            Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
       
            '记录如存在则读入其内容,否则提示记录已被其他人删除
            If Not RecTemp.EOF Then
                LrText(0).Tag = Trim(.Fields("PlanFeedbackID") & "")            '存货编码
                LrText(0).Text = Trim(.Fields("PlanFeedbackNum") & "")            '存货名称
                LrText(1).Tag = Trim(.Fields("PurPlanMainID") & "")          '存货规格
                LrText(1).Text = Trim(.Fields("PurPlanNum") & "")                 '图号
                LrText(2).Text = Format(.Fields("PlanDate"), "yyyy-mm-dd")
                LrText(3).Tag = .Fields("PlanDept") & ""
                LrText(3).Text = .Fields("DeptName") & ""
                LrText(4).Tag = .Fields("Buyer")
                LrText(4).Text = .Fields("PersonName")
                LrText(5).Text = Trim(.Fields("FinishCircs")) & ""
                LrText(6).Text = Trim(.Fields("ExistIssue")) & ""
                LrText(7).Text = Trim(.Fields("SettleWay")) & ""
                LrText(8).Text = Format(.Fields("PlanFeedbackDate") & "", "yyyy-mm-dd")
                LrText(9).Text = Trim(.Fields("Remark")) & ""
                LrText(2).Enabled = False
                LrText(3).Enabled = False
                LrText(4).Enabled = False
            Else
                Tsxx = "该记录已经被其他人删除,请刷新当前数据!"
                Call Xtxxts(Tsxx, 0, 4)
                Call Cancel
                TextChangeLock = False
                Exit Function
            End If
            
        End With
        
    End If
    
    Cshlrxx = True
    TextChangeLock = False
    
End Function

Private Sub Scdqjl()                 '删 除 当 前 记 录

    Dim yhAnswer As Integer
    
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log(Str_RightEdit, Xtczybm, 1) Then
        Exit Sub
    End If
    
    '非数据行不能删除
    If CzxsGrid.Row < CzxsGrid.FixedRows Then
        Exit Sub
    End If
  
    '用户确认是否删除记录
    Tsxx = "请确认是否删除当前记录?"
    yhAnswer = Xtxxts(Tsxx, 2, 2)
    
    If yhAnswer = 2 Then
        Exit Sub
    End If
  
    On Error GoTo Cwcl
  
    Cw_DataEnvi.DataConnect.BeginTrans
  
    '[以下需自定义部分
    Cw_DataEnvi.DataConnect.Execute "delete Cg_PlanFeedback where PlanFeedbackNum = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'"
    '以上为自定义部分]
  
    Cw_DataEnvi.DataConnect.CommitTrans
    
    CzxsGrid.RemoveItem CzxsGrid.Row
  
    Exit Sub
  
Cwcl:

    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "出现未知情况,该反馈单不能被删除!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Sub

    
End Sub

'*******************以下区域为编写自定义过程区域**********************


'*******************以上区域为编写自定义过程区域**********************

'*******************************以下为基本处理程序(固定不变)*******************************************'
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作

    If Shift = 2 Then
        Select Case UCase(Chr(KeyCode))
            Case "P"                                                                          'Ctrl+P 打印
                If SzToolbar.Buttons("dy").Visible And SzToolbar.Buttons("dy").Enabled Then
                    Call bbyl(False)
                End If
            Case "A"                                                                          'Ctrl+A 增加
                '判断用户是否有此功能执行权限,如有则写上机日志(进入)
                If Not Security_Log(Str_RightEdit, Xtczybm, 1) Then
                    Exit Sub
                End If
                If SzToolbar.Buttons("zj").Visible And SzToolbar.Buttons("zj").Enabled Then
                    Call Toolbjzt
                    Lrzt = 1
                    Call Cshlrxx(Lrzt)
                    LrText(0).Enabled = False
                    LrText(1).SetFocus
                End If
            Case "D"                                                                          'Ctrl+D 删除
                If SzToolbar.Buttons("sc").Visible And SzToolbar.Buttons("sc").Enabled Then
                    Call Scdqjl
                End If
        End Select
    End If
  
End Sub

Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)

    Select Case Button.Key
        Case "ymsz"                                          '页面设置
            Dyymctbl.Show 1
        Case "yl"                                            '预 览
            Call bbyl(True)
        Case "dy"                                            '打 印
             Call bbyl(False)
        Case "zj"                                            '增 加
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log(Str_RightEdit, Xtczybm, 1) Then
                Exit Sub
            End If
            Call Toolbjzt
            Lrzt = 1
            Call Cshlrxx(Lrzt)
            LrText(1).SetFocus
        Case "xg"                                            '修 改
            Call Xgdqjl
        Case "sc"                                            '删 除
            Call Scdqjl
        Case "sx"                                            '刷 新
            Call Cxnrtcwg
        Case "bz"                                            '帮 助
            Call F1bz
        Case "fh"                                            '退 出
            Unload Me
    End Select
    
End Sub

Private Sub CzxsGrid_DblClick()                                         '修改当前编码记录

    Call Xgdqjl
    
End Sub

Private Sub Xgdqjl()                                                    '修改当前编码记录
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log(Str_RightEdit, Xtczybm, 1) Then
        Exit Sub
    End If
    
    If CzxsGrid.Row < CzxsGrid.FixedRows Then
        Exit Sub
    End If
    
    Call Toolbjzt
    Lrzt = 2
    
    If Cshlrxx(Lrzt) Then
        LrText(1).SetFocus
        LrText(0).Enabled = False
    End If
  
End Sub