+

VB开发的ERP系统

    Select Case Button.Key
    Case "ymsz"                                          '页面设置
        Dyymctbl.Show 1
    Case "yl"                                            '预 览
        If Fun_Drfrmyxxpd Then
            Call bbyl(True)
        End If
    Case "dy"                                            '打 印
        If Fun_Drfrmyxxpd Then
            Call bbyl(False)
        End If
    Case "ph"                                            '试算平衡
        If Fun_Drfrmyxxpd Then
            Xtcdcs = Str(Int_OriYear)
            JC_FrmQcyessph.HelpContextID = Me.HelpContextID
            JC_FrmQcyessph.Show 1
        End If
    Case "dz"                                            '对帐
        If Fun_Drfrmyxxpd Then
            Xtcdcs = Str(Int_OriYear)       '对帐年度
            Xtcdcsfz = "1"                  '对帐会计期间
            JC_FrmQcyeDz.HelpContextID = Me.HelpContextID
            JC_FrmQcyeDz.Show 1
        End If
    Case "dw"                                            '定位
        If Fun_Drfrmyxxpd Then
            JC_FrmKmdw.Show 1
            If Xtfhcs <> "" Then
                With WglrGrid
                    For Jsqte = .FixedRows To .Rows - 1
                        If Mid(.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)), 1, Len(Xtfhcs)) = Xtfhcs Then
                            .Select Jsqte, Sydz("001", GridStr(), Szzls)
                            .TopRow = Jsqte
                            Exit For
                        End If
                    Next Jsqte
                End With
            End If
        End If
    Case "fz"                                            '辅助核算期初录入
        If Fun_Drfrmyxxpd Then
            With WglrGrid
                If .TextMatrix(.Row, 3) = "1" Or .TextMatrix(.Row, 4) = "1" Or .TextMatrix(.Row, 5) = "1" Or .TextMatrix(.Row, 6) = "1" Or .TextMatrix(.Row, 7) = "1" Then      '辅助核算
                    Xtcdcs = .TextMatrix(.Row, Sydz("001", GridStr(), Szzls))
                    JC_FrmQcAss0.HelpContextID = Me.HelpContextID
                    JC_FrmQcAss0.Show 1
                End If
            End With
        End If
    Case "bz"                                            '帮 助
        Call F1bz
    Case "fh"                                            '退 出
        Unload Me
        
    End Select
    
    '解 锁
    Valilock = False
    changelock = False
    
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 Tlb_Action.Buttons("dy").Enabled Then
                Call bbyl(False)
            End If
        End Select
    End If
End Sub

Private Sub Wbkcl()                                                 '文本框录入之前处理(根据实际情况)
    Dim xswbrr As String
    With WglrGrid
        Zdlrqnr = Trim(.Text)
        xswbrr = Trim(.Text)
        
        If GridBoolean(.Col, 3) Then   '列表框录入
            
            '填充列表框程序
            Call FillCombo(YdCombo, GridStr(.Col, 5), xswbrr, 0)
        Else
            Wbkbhlock = True
            
            '====以下为用户自定义
            Ydtext.Text = xswbrr
            '====以上为用户自定义
            
            Wbkbhlock = False
            Ydtext.SelStart = Len(Ydtext.Text)
        End If
    End With
End Sub

Private Function sjzdyxxpd(Dqpdwgh As Long, Dqpdwgl As Long)        '录入数据字段有效性判断,同时进行字段录入事后处理
    Dim Str_JudgeText As String            '临时有效性判断字段内容
    Dim Coljsq As Long                     '临时列计数器
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    Dim Dbl_Qcye As Double                 '临时期初余额
    
    With WglrGrid
        
        '非录入状态有效性为合法
        If Yxxpdlock Or .Row < .FixedRows Then
            sjzdyxxpd = True
            Exit Function
        End If
        
        Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
        Select Case GridStr(Dqpdwgl, 1)
            
            '以下为自定义部分[
            '1.放置字段有效性判断程序
            
        Case "006", "007", "008"            '年初余额,累计借方,累计贷方(本币金额)
            
            If .TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = "借" Then
                Dbl_Qcye = Val(.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls))) + Val(.TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls))) - Val(.TextMatrix(Dqpdwgh, Sydz("008", GridStr(), Szzls)))
            Else
                Dbl_Qcye = Val(.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls))) - Val(.TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls))) + Val(.TextMatrix(Dqpdwgh, Sydz("008", GridStr(), Szzls)))
            End If
            
            If Dbl_Qcye = 0 Then
                .TextMatrix(Dqpdwgh, Sydz("009", GridStr(), Szzls)) = ""
            Else
                .TextMatrix(Dqpdwgh, Sydz("009", GridStr(), Szzls)) = Dbl_Qcye
            End If
            
        Case "010", "011", "012"            '年初余额,累计借方,累计贷方(数量)
            
            If .TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = "借" Then
                Dbl_Qcye = Val(.TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls))) + Val(.TextMatrix(Dqpdwgh, Sydz("011", GridStr(), Szzls))) - Val(.TextMatrix(Dqpdwgh, Sydz("012", GridStr(), Szzls)))
            Else
                Dbl_Qcye = Val(.TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls))) - Val(.TextMatrix(Dqpdwgh, Sydz("011", GridStr(), Szzls))) + Val(.TextMatrix(Dqpdwgh, Sydz("012", GridStr(), Szzls)))
            End If
            
            If Dbl_Qcye = 0 Then
                .TextMatrix(Dqpdwgh, Sydz("013", GridStr(), Szzls)) = ""
            Else
                .TextMatrix(Dqpdwgh, Sydz("013", GridStr(), Szzls)) = Dbl_Qcye
            End If
            
        Case "014", "015", "016"            '年初余额,累计借方,累计贷方(外币金额)
            
            If .TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = "借" Then
                Dbl_Qcye = Val(.TextMatrix(Dqpdwgh, Sydz("014", GridStr(), Szzls))) + Val(.TextMatrix(Dqpdwgh, Sydz("015", GridStr(), Szzls))) - Val(.TextMatrix(Dqpdwgh, Sydz("016", GridStr(), Szzls)))
            Else
                Dbl_Qcye = Val(.TextMatrix(Dqpdwgh, Sydz("014", GridStr(), Szzls))) - Val(.TextMatrix(Dqpdwgh, Sydz("015", GridStr(), Szzls))) + Val(.TextMatrix(Dqpdwgh, Sydz("016", GridStr(), Szzls)))
            End If
            
            If Dbl_Qcye = 0 Then
                .TextMatrix(Dqpdwgh, Sydz("017", GridStr(), Szzls)) = ""
            Else
                .TextMatrix(Dqpdwgh, Sydz("017", GridStr(), Szzls)) = Dbl_Qcye
            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                   '临时查询字符串
    Dim Dbl_Ori(1 To 12) As Double         '科目记录原数据
    Dim Dbl_Now(1 To 12) As Double         '科目记录现数据
    Dim Str_Ccode As String                '操作科目
    Dim Rec_AccSum As New ADODB.Recordset  '科目总帐动态集
    Dim Bln_Foreign As Boolean             '外币核算
    Dim Lng_GridRow As Long                '定位科目所在网格行
    
    With WglrGrid
        
        '行没有发生变化则不进行有效性判断
        If Hyxxpdlock Then
            Sjhzyxxpd = True
            Exit Function
        End If
        
        '以下为自定义部分[
        
        '1.放置行有效性判断程序
        
        '首先进行为空判断(固定不变)
        For Jsqte = Qslz To .Cols - 1
            
            '字段不能为空
            If GridInt(Jsqte, 5) = 1 Then
                If Len(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0 Then
                    Tsxx = GridStr(Jsqte, 2)
                    Lrywlz = Jsqte
                    GoTo Lrcwcl
                    Exit For
                End If
            End If
            
            '字段不能为零
            If GridInt(Jsqte, 5) = 2 Then
                If Val(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0 Then
                    Tsxx = GridStr(Jsqte, 2)
                    Lrywlz = Jsqte
                    GoTo Lrcwcl
                    Exit For
                End If
            End If
        Next Jsqte
        
        
        '2.放置行处理程序
        
        '[>>当用户录入数据完毕后自动进行本科目及上级科目数据回写
        
        Str_Ccode = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("001", GridStr(), Szzls)))
        
        If WglrGrid.TextMatrix(Yxxpdh, 2) = "1" Then
            Bln_Foreign = True
        Else
            Bln_Foreign = False
        End If
        
        Sqlstr = "SELECT * FROM Cwzz_AccSum Where Ccode='" & Str_Ccode & "' And Year=" & Int_OriYear & " And Period=1"
        Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        If Not RecTemp.EOF Then
            Dbl_Ori(1) = RecTemp.Fields("Ycye")         '年初余额
            Dbl_Ori(2) = RecTemp.Fields("Byjfljje")     '本年借方累计金额
            Dbl_Ori(3) = RecTemp.Fields("Bydfljje")     '本年贷方累计金额
            Dbl_Ori(4) = RecTemp.Fields("Qmye")         '期末余额
            Dbl_Ori(5) = RecTemp.Fields("Ycsl")         '年初数量
            Dbl_Ori(6) = RecTemp.Fields("Byjfljsl")     '本年借方累计数量
            Dbl_Ori(7) = RecTemp.Fields("Bydfljsl")     '本年贷方累计金额
            Dbl_Ori(8) = RecTemp.Fields("Qmsl")         '期末数量
            Dbl_Ori(9) = RecTemp.Fields("Ycwb")         '年初外币
            Dbl_Ori(10) = RecTemp.Fields("Byjfljwb")    '本年借方累计外币
            Dbl_Ori(11) = RecTemp.Fields("Bydfljwb")    '本年贷方累计外币
            Dbl_Ori(12) = RecTemp.Fields("Qmwb")        '期末外币
        End If
        If WglrGrid.TextMatrix(Yxxpdh, Sydz("005", GridStr(), Szzls)) = "借" Then
            Dbl_Now(1) = Val(.TextMatrix(Yxxpdh, Sydz("006", GridStr(), Szzls)))       '年初余额
            Dbl_Now(2) = Val(.TextMatrix(Yxxpdh, Sydz("007", GridStr(), Szzls)))       '本年借方累计金额
            Dbl_Now(3) = Val(.TextMatrix(Yxxpdh, Sydz("008", GridStr(), Szzls)))       '本年贷方累计金额