VB开发的ERP系统

    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    If Not RecTemp.EOF Then
        Int_Year = RecTemp.Fields("Year")
        Int_Period = RecTemp.Fields("Period")
    End If
    
    '初始化各种锁值
    changelock = False             '网格行列改变控制锁
    Gdtlock = False                '滚动条滚动控制
    Yxxpdlock = True               '字段有效性判断锁
    Hyxxpdlock = True              '行有效性判断锁
    Wbkbhlock = False              '文本框内容改变锁
    
    '调 入 网 格
    GridCode = "Cwzz_xjllsjtz"     '网格属性编码
    Call BzWgcsh(WglrGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
    
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Pmbcsjhs = GridInf(3)
    Fzxwghs = GridInf(4)
    Sfblbzkd = GridInf(5)
    Shsfts = GridInf(6)
    Sfxshjwg = GridInf(7)
    Szzls = WglrGrid.Cols - 1
    
    '生成查询结果
    Call Sub_Query(Lng_VouchId)
    
    '设置状态为修改状态
    Lab_OperStatus = "2"
    
End Sub

Private Sub Form_Unload(Cancel As Integer)           '窗体卸载
    
    '卸载打印页面窗体
    Unload Dyymctbl
    
End Sub

Private Sub Sub_Query(Lng_VouchId1 As Long)                              '显示当前凭证分配金额
    Dim SqlStr As String                   '查询字符串
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    Dim Jsqte  As Long                     '临时计数器
    
    SqlStr = "SELECT Cwzz_CashFlowData.*,Cwzz_CashFlowItem.CashFlowName From Cwzz_CashFlowData LEFT OUTER JOIN Cwzz_CashFlowItem ON" & _
    " Cwzz_CashFlowData.CashFlowId = Cwzz_CashFlowItem.CashFlowId Where Cwzz_CashFlowData.VouchID=" & Lng_VouchId1 & " Order By CashFlowDataID"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    
    With RecTemp
        
        WglrGrid.Clear 1
        
        WglrGrid.Rows = .RecordCount + WglrGrid.FixedRows
        
        Jsqte = WglrGrid.FixedRows
        Do While Not .EOF
            If Jsqte >= WglrGrid.Rows Then
                WglrGrid.AddItem ""
            End If
            
            WglrGrid.TextMatrix(Jsqte, 0) = "*"                                                              '有效记录标识
            
            WglrGrid.TextMatrix(Jsqte, 1) = Trim(.Fields("CashFlowID") & "")                                 '现金流量项目ID
            WglrGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("CashFlowName") & "")                                   '部门编码
            
            If .Fields("Fpje") <> 0 Then                                                                     '分配金额
                WglrGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = .Fields("Fpje")
            End If
            
            '<<]
            WglrGrid.RowHeight(Jsqte) = Sjhgd
            .MoveNext
            Jsqte = Jsqte + 1
        Loop
    End With
    
    '调整网格
    Call Sub_AdjustGrid
    
    '计算分配金额
    Call Sub_Jsfpje
    
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 "001"          '现金流量项目(如有效则调入现金流量项目名称)
            If Len(Str_JudgeText) <> 0 Then
                SqlStr = "Select CashFlowID,CashFlowCode,CashFlowName FROM Cwzz_CashFlowItem Where ltrim(CashFlowCode)='" & Str_JudgeText & "' OR ltrim(CashFlowName)='" & Str_JudgeText & "'"
                Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                With RecTemp
                    If .EOF Then
                        Tsxx = "此现金流量项目不存在!"
                        GoTo Lrcwcl
                    End If
                    
                    '1.如果现金流量项目存在则存储相应现金流量编码
                    WglrGrid.TextMatrix(Dqpdwgh, 1) = Trim(RecTemp.Fields("CashFlowID"))
                    WglrGrid.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = Trim(RecTemp.Fields("CashFlowName"))
                End With
            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 Rec_AccSumAssi As New ADODB.Recordset      '辅助总帐动态集
    Dim Dbl_Now(1 To 16) As Double                 '科目记录现数据
    Dim Str_OriItemCode As String                  '辅助核算项目编码(原)
    Dim Str_NowItemCode 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
        
        '计算分配金额
        Call Sub_Jsfpje
        
        '以上为自定义部分]
    End With
    
    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 Sub Sub_Jsfpje()                                        '计算凭证分配现金流量金额
    Dim Dbl_Fpje As Double
    Dbl_Fpje = 0
    With WglrGrid
        For Jsqte = .FixedRows To .Rows - 1
            If .TextMatrix(Jsqte, 0) = "*" Then
                Dbl_Fpje = Dbl_Fpje + Val(.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)))
            End If
        Next Jsqte
    End With
    If Dbl_Fpje = 0 Then
        Lab_Fpje.Caption = ""
    Else
        Lab_Fpje.Caption = Dbl_Fpje
    End If
End Sub

Private Sub QdCommand_Click()                                                                     '确定
    Dim Rec_CashFlowData As New ADODB.Recordset      '现金流量表动态集
    
    '计算分配金额
    Call Sub_Jsfpje
    
    '分配金额不能大于凭证合计金额
    If Val(Lab_Fpje.Caption) > Val(Lab_Pzjehj.Caption) Then
        Tsxx = "现金流量分配金额不能大于凭证合计金额"
        Call Xtxxts(Tsxx, 0, 4)
        Exit Sub
    End If
    
    '数据回写
    On Error GoTo Swcwcl
    
    Cw_DataEnvi.DataConnect.BeginTrans
    
    '1.删除原此凭证所分配现金流量
    Cw_DataEnvi.DataConnect.Execute ("Delete Cwzz_CashFlowData Where VouchID=" & Lng_VouchId)
    
    '2.添加目前分配现金流量
    If Rec_CashFlowData.State = 1 Then Rec_CashFlowData.Close
    Rec_CashFlowData.Open "Select * From Cwzz_CashFlowData Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    
    For Rowjsq = WglrGrid.FixedRows To WglrGrid.Rows - 1
        
        If WglrGrid.TextMatrix(Rowjsq, 0) <> "*" Then
            Exit For
        End If
        
        With Rec_CashFlowData
            .AddNew
            .Fields("VouchID") = Lng_VouchId                                                    '凭证ID
            .Fields("Year") = Int_Year                                                          '会计年度
            .Fields("Period") = Int_Period                                                      '会计期间
            .Fields("CashFlowID") = Val(WglrGrid.TextMatrix(Rowjsq, 1))                          '现金流量项目
            .Fields("Fpje") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)))    '现金流量分配金额
            .Update
            
        End With
        
    Next Rowjsq
    
    
    Cw_DataEnvi.DataConnect.CommitTrans
    
    Unload Me
    Exit Sub
    
Swcwcl:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Sub
End Sub

Private Sub QxCommand_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)    '取消
    changelock = True              '网格行列改变控制锁
    Yxxpdlock = True               '字段有效性判断锁
    Hyxxpdlock = True              '行有效性判断锁
    Wbkbhlock = True               '文本框内容改变锁
    Unload Me
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