+

VB开发的ERP系统

        Case "001"          '核算科目
            If Len(Str_JudgeText) <> 0 Then
                Sqlstr = "Select Cwzz_AccCode.Ccode,Cwzz_AccCode.Cname,BalanceOri,ParentCode FROM  Cwzz_AccCode " & _
                " Where Ccode='" & Str_JudgeText & "' OR AssCode='" & Str_JudgeText & "'"
                Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                With RecTemp
                    If .EOF Then
                        Tsxx = "此科目不存在!"
                        GoTo Lrcwcl
                    End If
                End With
                
                For Jsqte = .FixedRows To .Rows - 1
                    If WglrGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Trim(RecTemp.Fields("Ccode")) And Dqpdwgh <> Jsqte Then
                        Tsxx = "核算科目重复!"
                        GoTo Lrcwcl
                    End If
                Next Jsqte
                
                '显示科目名称,得栏目名称和分析方向
                WglrGrid.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = Trim(RecTemp.Fields("Ccode"))
                WglrGrid.TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = Trim(RecTemp.Fields("Cname"))
                WglrGrid.TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = Trim(RecTemp.Fields("BalanceOri"))
                Str_ItemName = Trim(RecTemp.Fields("Cname"))
                Str_ParentCode = Trim(RecTemp.Fields("ParentCode") & "")
                Sqlstr = "Select Cwzz_AccCode.Cname FROM  Cwzz_AccCode " & _
                " Where Ccode='" & Str_ParentCode & "'"
                Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                If Not RecTemp.EOF Then
                    Str_ItemName = Mid(Replace(Str_ItemName, Trim(RecTemp.Fields("Cname")) & "/", ""), 1, 20)
                End If
                WglrGrid.TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = Str_ItemName
                
            End If
            
            
            '2.放置字段事后处理程序
            
            '以上为自定义部分]
            
        End Select
        
        '字段录入正确后为零字段清空
        Call Qkwlzd(Dqpdwgh, Dqpdwgl)
        
        sjzdyxxpd = True
        Yxxpdlock = True
        Exit Function
    End With
    
Lrcwcl:    '录入错误处理
    With WglrGrid
        Call Xtxxts(Tsxx, 0, 1)
        changelock = True
        .Select Dqpdwgh, Dqpdwgl
        changelock = False
        Call xswbk
        sjzdyxxpd = False
        Exit Function
    End With
End Function

Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean                  '录入数据行有效性判断,同时进行行处理
    Dim Lrywlz As Long
    Dim RecTemp As New ADODB.Recordset             '临时使用动态集
    Dim Sqlstr As String                           '临时连接字符串
    
    With WglrGrid
        
        '判断行为空和无效数据行则清除当前行
        If Yxxpdh > (.Rows - .FixedRows) Then Exit Function
        If .TextMatrix(Yxxpdh, 0) <> "*" Then
            Sjhzyxxpd = True
            Exit Function
        Else
            If pdhwk(Yxxpdh) And Yxxpdh + 1 <= .Rows - 1 Then
                If .TextMatrix(Yxxpdh + 1, 0) <> "*" Then
                    changelock = True
                    .RemoveItem Yxxpdh
                    If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
                        .AddItem ""
                        .RowHeight(.Rows - 1) = Sjhgd
                    End If
                    changelock = False
                    Sjhzyxxpd = True
                    Exit Function
                End If
            End If
        End If
        
        '行没有发生变化则不进行有效性判断
        If Hyxxpdlock Then
            Sjhzyxxpd = True
            Exit Function
        End If
        
        
        '以下为自定义部分[
        
        '1.放置行有效性判断程序
        
        '首先进行为空判断(固定不变)
        For Jsqte = Qslz To .Cols - 1
            If (GridInt(Jsqte, 5) = 1 And Len(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0) Or (GridInt(Jsqte, 5) = 2 And Val(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0) Then
                Tsxx = GridStr(Jsqte, 2)
                Lrywlz = Jsqte
                GoTo Lrcwcl
                Exit For
            End If
        Next Jsqte
        
        '2.放置行处理程序
        
        
        '<<]
        
        '以上为自定义部分]
        
    End With
    
    Bln_BillChange = True
    
    Sjhzyxxpd = True
    Hyxxpdlock = True
    Exit Function
    
Lrcwcl:      '录入错误处理
    With WglrGrid
        Call Xtxxts(Tsxx, 0, 1)
        changelock = True
        .Select Yxxpdh, Lrywlz
        changelock = False
        Call xswbk
        
        Sjhzyxxpd = False
        Exit Function
    End With
End Function

Private Function Sub_SaveEdit() As Boolean                   '保 存 设 置
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    Dim Sqlstr As String
    Dim Rowjsq As Long           '网格行计数器
    Dim Coljsq As Long           '网格列计数器
    Dim Jsqte As Integer         '临时计数器
    Dim Int_RowCount As Integer  '有效数据行计数器
    
    With WglrGrid
        
        On Error GoTo Swcwcl
        
        Cw_DataEnvi.DataConnect.BeginTrans
        
        Cw_DataEnvi.DataConnect.Execute ("Delete Cwzz_AccMultiItem Where AccMultiCode='" & Str_AccMultiCode & "'")
        
        For Rowjsq = WglrGrid.FixedRows To WglrGrid.Rows - 1
            
            If WglrGrid.TextMatrix(Rowjsq, 0) <> "*" Then
                Exit For
            End If
            
            Sqlstr = "Insert Into Cwzz_AccMultiItem (AccMultiCode,Ccode,ItemName,AnalyseOri) values ('" & Str_AccMultiCode & "','" & Trim(.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls))) & "','" & Trim(.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls))) & "','" & Trim(.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) & "')"
            Cw_DataEnvi.DataConnect.Execute (Sqlstr)
            
        Next Rowjsq
        Cw_DataEnvi.DataConnect.CommitTrans
        
        
    End With
    
    Bln_BillChange = False
    Sub_SaveBill = True
    Tsxx = "保存设置完毕!"
    Call Xtxxts(Tsxx, 0, 4)
    
    Unload Me
    
    Exit Function
    
Swcwcl:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Function
End Function

Private Sub Sub_AutoEdit()                                     '自动编制
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    Dim Rec_AccCode As New ADODB.Recordset
    Dim Str_ItemName As String             '栏目名称
    Dim Str_ParentCode As String           '上级科目编码
    Dim Yhanswer As Integer                '回答是否确认
    Dim Jsqte As Long                      '网格行计数器
    
    '用户确认是否自动编制
    Tsxx = "请确认是否覆盖原有栏目设置?"
    Yhanswer = Xtxxts(Tsxx, 2, 2)
    If Yhanswer = 2 Then
        Exit Sub
    End If
    
    With WglrGrid
        WglrGrid.Clear 1
        
        WglrGrid.Rows = WglrGrid.FixedRows
        
        Jsqte = WglrGrid.FixedRows
        
        Sqlstr = "Select Cwzz_AccCode.Ccode,Cwzz_AccCode.Cname,BalanceOri,ParentCode FROM  Cwzz_AccCode " & _
        " Where ParentCode='" & Trim(Lab_Ccode.Caption) & "'"
        Set Rec_AccCode = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        
        Do While Not Rec_AccCode.EOF
            If Jsqte >= WglrGrid.Rows Then
                WglrGrid.AddItem ""
            End If
            
            WglrGrid.TextMatrix(Jsqte, 0) = "*"
            
            '显示科目名称,得栏目名称和分析方向
            WglrGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Trim(Rec_AccCode.Fields("Ccode"))
            WglrGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(Rec_AccCode.Fields("Cname"))
            WglrGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Trim(Rec_AccCode.Fields("BalanceOri"))
            Str_ItemName = Trim(Rec_AccCode.Fields("Cname"))
            Str_ParentCode = Trim(Rec_AccCode.Fields("ParentCode") & "")
            Sqlstr = "Select Cwzz_AccCode.Cname FROM  Cwzz_AccCode " & _
            " Where Ccode='" & Str_ParentCode & "'"
            Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            If Not RecTemp.EOF Then
                Str_ItemName = Mid(Replace(Str_ItemName, Trim(RecTemp.Fields("Cname")) & "/", ""), 1, 20)
            End If
            
            WglrGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Str_ItemName
            
            WglrGrid.RowHeight(Jsqte) = Sjhgd
            Rec_AccCode.MoveNext
            Jsqte = Jsqte + 1
            
        Loop
        
        '调整网格
        Call Sub_AdjustGrid
        
        '标识变动
        Bln_BillChange = True
        
    End With
End Sub

'===================以 下 程 序 为 通 用 部 分 ,一 般 不 需 更 改======================='
Private Sub Sub_AdjustGrid()
    '调 整 网 格
    With WglrGrid
        '加 1 保持一行录入行
        If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
            .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
            For Jsqte = .FixedRows To .Rows - 1
                .RowHeight(Jsqte) = Sjhgd
            Next Jsqte
        Else
            '判断是否有辅助行和录入行,如没有则加行
            Do While .TextMatrix(.Rows - 1 - Fzxwghs, 0) = "*"
                .AddItem ""
                .RowHeight(.Rows - 1) = Sjhgd
            Loop
        End If
    End With
End Sub

Private Sub Lrzdbz()                                                      '录入字段帮助
    If Not Ydcommand.Visible Then
        Exit Sub
    End If
    Valilock = True
    With WglrGrid
        
        changelock = True        '调入另外窗体必须加锁
        Call Drbmhelp(GridInt(.Col, 6), GridStr(.Col, 3), Trim(Ydtext.Text))
        changelock = False
        If Len(Xtfhcs) <> 0 Then
            If GridInt(.Col, 7) = 0 Then
                Ydtext.Text = Xtfhcs
            Else
                Ydtext.Text = Xtfhcsfz
            End If
        End If
        
        Valilock = False
        If Ydtext.Visible Then
            Ydtext.SetFocus
        End If
    End With
End Sub

Private Sub Form_Resize()                                                '窗体大小发生变化时,重新显示文本框
    Call Cxxswbk
End Sub

Private Function Fun_Drfrmyxxpd() As Boolean                             '调入其它窗体或功能产生的有效性判断(包括数据回写)
    Fun_Drfrmyxxpd = True
    With WglrGrid
        
        '如果当前网格处于编辑状态,则先进行数据回写再进行有效性判断
        
        If Ydtext.Visible Or YdCombo.Visible Then
            Call Lrsjhx
            If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
                Fun_Drfrmyxxpd = False
                Exit Function
            End If
        End If
        
        '进行行有效性判断
        If Not Sjhzyxxpd(.Row) Then
            Fun_Drfrmyxxpd = False
            Exit Function
        End If
        
    End With
End Function

Private Sub WglrGrid_GotFocus()                                     '网格得到焦点
    
    '网格得到焦点,如果当前选择行为非数据行
    '则调整当前焦点至有效数据行
    
    With WglrGrid
        If .Row < .FixedRows And .Rows > .FixedRows Then
            changelock = True
            .Select .FixedRows, .Col
            changelock = False
        End If
        If .Col < Qslz Then
            changelock = True
            .Select .Row, Qslz
            changelock = False
        End If
    End With
    
End Sub

Private Sub WglrGrid_LostFocus()                                    '录入网格失去焦点
    
    '用以屏蔽调用其它窗体时发生网格失去焦点事件
    If changelock Then
        Exit Sub
    End If
    
    '引发网格RowcolChange事件
    With WglrGrid
        If Not (Ydtext.Visible Or YdCombo.Visible) Then
            .Select 0, 0
        End If
    End With
    
End Sub

Private Sub WglrGrid_AfterScroll(ByVal OldTopRow As Long, ByVal OldLeftCol As Long, ByVal NewTopRow As Long, ByVal NewLeftCol As Long)                                       '限制用户在录入过程中滚动鼠标
    
    If Gdtlock Then
        Exit Sub
    End If