VB开发的ERP系统

            CxbbGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("Ccode") & "")            '科目编码
            CxbbGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("Cname") & "")            '科目名称
            If .Fields("Jfje") <> 0 Then                                                                       '借方金额
                CxbbGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Trim(Str(.Fields("Jfje")))
            End If
            If .Fields("Dfje") <> 0 Then                                                                       '贷方金额
                CxbbGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Trim(Str(.Fields("Dfje")))
            End If
            CxbbGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = Trim(.Fields("Bill") & "")             '制单人
            CxbbGrid.TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)) = Trim(.Fields("Checker") & "")          '审核人
            CxbbGrid.TextMatrix(Jsqte, Sydz("010", GridStr(), Szzls)) = Trim(.Fields("Book") & "")             '记帐人
            CxbbGrid.TextMatrix(Jsqte, Sydz("011", GridStr(), Szzls)) = Trim(.Fields("VouchSource") & "")      '凭证来源
            
            If .Fields("ErrorFlag") Then                                                                       '有错凭证(红色显示)
                CxbbGrid.Cell(flexcpBackColor, Jsqte, 0, , CxbbGrid.Cols - 1) = Lab_Color(1).BackColor
            End If
            
            '计算本张凭证合计
            Dbl_Jfhj = Dbl_Jfhj + .Fields("Jfje")
            Dbl_Dfhj = Dbl_Dfhj + .Fields("Dfje")
            
            CxbbGrid.RowHeight(Jsqte) = Sjhgd
            
            Jsqte = Jsqte + 1
            .MoveNext
            
            '判断是否输出合计
            If PZ_FrmPzcxtj.Chk_Sum.Value = 1 Then
                If .EOF Then
                    CxbbGrid.AddItem ""
                    CxbbGrid.RowHeight(Jsqte) = Sjhgd
                    CxbbGrid.TextMatrix(Jsqte, 0) = Int_VouchID            '凭证ID
                    CxbbGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = "合 计"
                    If Dbl_Jfhj <> 0 Then                                                                       '借方合计
                        CxbbGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Trim(Str(Dbl_Jfhj))
                    End If
                    If Dbl_Dfhj <> 0 Then                                                                       '贷方合计
                        CxbbGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Trim(Str(Dbl_Dfhj))
                    End If
                    
                    '合计清零
                    Dbl_Jfhj = 0
                    Dbl_Dfhj = 0
                    
                    CxbbGrid.Cell(flexcpBackColor, Jsqte, 0, , CxbbGrid.Cols - 1) = Lab_Color(0).BackColor
                    Jsqte = Jsqte + 1
                Else
                    If Int_VouchID <> .Fields("VouchID") Then
                        CxbbGrid.AddItem ""
                        CxbbGrid.RowHeight(Jsqte) = Sjhgd
                        CxbbGrid.TextMatrix(Jsqte, 0) = Int_VouchID            '凭证ID
                        CxbbGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = "合 计"
                        If Dbl_Jfhj <> 0 Then                                                                       '借方合计
                            CxbbGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Trim(Str(Dbl_Jfhj))
                        End If
                        If Dbl_Dfhj <> 0 Then                                                                       '贷方合计
                            CxbbGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Trim(Str(Dbl_Dfhj))
                        End If
                        
                        '合计清零
                        Dbl_Jfhj = 0
                        Dbl_Dfhj = 0
                        
                        CxbbGrid.Cell(flexcpBackColor, Jsqte, 0, , CxbbGrid.Cols - 1) = Lab_Color(0).BackColor
                        Jsqte = Jsqte + 1
                    End If
                End If
            End If
            
        Loop
        
    End With
    
    ']以上为用户自定义部分
    
End Sub

Private Sub CxbbGrid_DblClick()          '用户双击网格调入相应凭证
    Dim RecTemp As New ADODB.Recordset
    
    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Then
        Exit Sub
    End If
    
    Sqlstr = "SELECT VouchID From Cwzz_AccVouchMain" & _
    " Where VouchID=" & Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
    
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    With RecTemp
        
        If .EOF Then
            Tsxx = "此凭证已被其他用户删除!"
            Call Xtxxts(Tsxx, 0, 4)
            Exit Sub
        Else
            
            With PZ_JzpzclFrm
                '填充查询凭证标识
                .Lab_VouchId = Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
                
                '设置凭证处理为列表查询状态
                .Lab_Pzclzt.Caption = "2"
                
                .Show 1
                
            End With
            
            If Xtfhcs = "1" Then
                Tsxx = "凭证发生变化,是否刷新凭证列表?"
                Yhanswer = Xtxxts(Tsxx, 2, 2)
                If Yhanswer = 1 Then
                    Call Timer1_Timer
                End If
            End If
            
        End If
        
    End With
    
End Sub

Private Sub Sub_AddBill()                                                '新增单据
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
         Exit Sub
    End If
    
    With PZ_JzpzclFrm
        '设置凭证处理为填制凭证状态
        .Lab_Pzclzt.Caption = "1"
        
        .Show 1
        
    End With
    
    If Xtfhcs = "1" Then
        Tsxx = "凭证发生变化,是否刷新凭证列表?"
        Yhanswer = Xtxxts(Tsxx, 2, 2)
        If Yhanswer = 1 Then
            Call Timer1_Timer
        End If
    End If
    
End Sub

Private Sub Sub_DeleteBill()                                             '删除选中当前单据
    Dim YAnswer As Integer
    Dim Int_VouchID%                       '凭证标识
    
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
         Exit Sub
    End If
    
    '光标处于非数据行不进行删除动作
    If CxbbGrid.Row < CxbbGrid.FixedRows Then
        Exit Sub
    End If
    
    '判断当前凭证是否允许删除
    If Not Fun_AllowEdit Then
        Exit Sub
    End If
    
    Tsxx = "请确认是否删除当前凭证?"
    Yhanswer = Xtxxts(Tsxx, 2, 2)
    If Yhanswer = 1 Then
        '1.删除凭证所有内容
        Int_VouchID = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
        
        On Error GoTo Swcwcl
        
        Cw_DataEnvi.DataConnect.BeginTrans
        
        Cw_DataEnvi.DataConnect.Execute ("Delete Cwzz_AccVouchSub Where VouchID=" & Int_VouchID)
        Cw_DataEnvi.DataConnect.Execute ("Delete Cwzz_AccVouchMain Where VouchID=" & Int_VouchID)
        'add by 奚俊峰
        Cw_DataEnvi.DataConnect.Execute ("Delete from Cwzz_CashFlowData Where VouchID=" & Int_VouchID)
        
        Cw_DataEnvi.DataConnect.CommitTrans
        
        On Error GoTo 0
        
        '删除网格中凭证数据
        Jsqte = CxbbGrid.FixedRows
        Do While Jsqte <= CxbbGrid.Rows - 1
            If Val(CxbbGrid.TextMatrix(Jsqte, 0)) = Int_VouchID Then
                CxbbGrid.RemoveItem (Jsqte)
            Else
                Jsqte = Jsqte + 1
            End If
        Loop
    Else
        Exit Sub
    End If
    
    Exit Sub
Swcwcl:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "删除凭证过程中出现未知错误,程序自动恢复删除前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Sub
    
End Sub

Private Function Fun_AllowEdit() As Boolean                      '判断当前凭证是否允许编辑或删除
    Dim RecTemp As New ADODB.Recordset                           '临时使用动态集
    Dim Int_VouchID%                                             '凭证标识
    
    Int_VouchID = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
    Sqlstr = "Select CheckFlag,BookFlag,Checker,Book From Cwzz_AccVouchMain Where VouchID=" & Int_VouchID
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With RecTemp
        If Not .EOF Then
            If .Fields("CheckFlag") Or .Fields("BookFlag") Then
                Tsxx = "该凭证已审核或记帐,不允许修改或删除!"
                Call Xtxxts(Tsxx, 0, 4)
                Lab_Checker = Trim(.Fields("Checker") & "")
                Lab_Book = Trim(.Fields("Book") & "")
                Exit Function
            End If
        End If
    End With
    Fun_AllowEdit = True
End Function

Private Sub Sub_CheckBill()                            '审核凭证
    Dim Yhanswer As Integer
    
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log(Str_RightCheck, Xtczybm, 1, True) Then
         Exit Sub
    End If
    
    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Then
        Exit Sub
    End If
    
    Sqlstr = "SELECT VouchID From Cwzz_AccVouchMain" & _
    " Where VouchID=" & Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
    
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    With RecTemp
        
        If .EOF Then
            Tsxx = "此凭证已被其他用户删除!"
            Call Xtxxts(Tsxx, 0, 4)
            Exit Sub
        Else
            
            With PZ_JzpzclFrm
                '填充查询凭证标识
                .Lab_VouchId = Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
                
                '设置凭证处理为审核凭证状态
                .Lab_Pzclzt.Caption = "3"
                
                .Show 1
                
                If Xtfhcs = "1" Then
                    Tsxx = "凭证发生变化,是否刷新凭证列表?"
                    Yhanswer = Xtxxts(Tsxx, 2, 2)
                    If Yhanswer = 1 Then
                        Call Timer1_Timer
                    End If
                End If
                
            End With
        End If
        
    End With
    
End Sub

Private Sub bbyl(bbylte As Boolean)                      '报表打印预览
    Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
    Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
    Bbxbtgs = 1                                          '报 表 小 标 题 行 数
    Bbbwhgs = 0                                          '报 表 表 尾 行 数
    ReDim Bbxbt(1 To Bbxbtgs)
    ReDim bbxbtzzxs(1 To Bbxbtgs)
    If Bbbwhgs <> 0 Then
        ReDim Bbbwh(1 To Bbbwhgs)
        ReDim Bbbwhzzxs(1 To Bbbwhgs)
    End If
    Bbzbt = ReportTitle
    Bbxbt(1) = " "
    bbxbtzzxs(1) = 0                                     '报表行组织形式(0-居左 1-居中 2-居右)
    Call Scyxsjb(CxbbGrid)                               '生成报表数据
    Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
    If Not bbylte Then
        Unload DY_Tybbyldy
    End If
End Sub