VB开发的ERP系统

        If yhAnswer = 1 Then
            Xt_Wait.Show
            Xt_Wait.Refresh
            
            '加快显示速度
            CxbbGrid.Redraw = False
            
            '生成查询结果
            Call Sub_Query(1)
            
            CxbbGrid.Redraw = True
            Xt_Wait.Hide
        End If
    End If
   
End Sub

Private Sub Sub_DeleteBill()                                            '删除选中当前单据
    
    Dim YAnswer As Integer
    Dim Lng_BillID As Long           '单据标识
    
    '记录行总数与固定行数相等则退出
    If CxbbGrid.Rows = CxbbGrid.FixedRows Then Exit Sub

    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
        Exit Sub
    End If
  
    Tsxx = "请确认是否删除当前期初应收单?"
    yhAnswer = Xtxxts(Tsxx, 2, 2)
  
    If yhAnswer = 1 Then
  
        '1.判断当前单据是否允许删除
        If Not Fun_AllowDelete Then
            Exit Sub
        End If
  
        '2.删除单据所有内容
        Lng_BillID = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
      
        On Error GoTo Swcwcl
    
        Cw_DataEnvi.DataConnect.BeginTrans
        Cw_DataEnvi.DataConnect.Execute ("Delete RP_AccList Where AccListID=" & Lng_BillID)        '删除单据内容
        Cw_DataEnvi.DataConnect.CommitTrans
    
        '重新统计合计金额
        YbTotal = YbTotal - CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("011", GridStr(), Szzls))
        BbTotal = BbTotal - CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("013", GridStr(), Szzls))

        '删除网格中单据数据
        CxbbGrid.RemoveItem (CxbbGrid.Row)

        '刷新合计行
        If BbTotal <> 0 Or YbTotal <> 0 Then
            CxbbGrid.TextMatrix(CxbbGrid.Rows - 1, Sydz("004", GridStr(), Szzls)) = "  合  计"
            If Str_Foreign <> "" Then
                 CxbbGrid.TextMatrix(CxbbGrid.Rows - 1, Sydz("011", GridStr(), Szzls)) = YbTotal
            End If
            CxbbGrid.TextMatrix(CxbbGrid.Rows - 1, Sydz("013", GridStr(), Szzls)) = BbTotal
        Else
            CxbbGrid.RemoveItem (CxbbGrid.Rows - 1)
        End If
        
    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_AllowDelete() As Boolean                                        '判断当前单据是否允许删除
  
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    Dim Sqlstr As String                   '查询字符串
    Dim Lng_BillID As Long                 '单据ID
  
    Lng_BillID = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
    Sqlstr = "Select Checker From RP_AccList Where AccListId=" & Lng_BillID
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With RecTemp
        If Not .EOF Then
            If Trim(.Fields("Checker") & "") <> "" Then
                Tsxx = "该期初应收单已审核确认,不能删除!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            End If
            End If
    End With
    Fun_AllowDelete = True
  
End Function

'[>>===================以下为根据实际业务需要自定义过程区域=============================<<]

'读取启用会计期间
Private Sub Sub_GetKjPeriod()
    Dim Rec_Kjqj As New ADODB.Recordset
    Dim Sql_Kjqj As String
    
    Sql_Kjqj = "Select Kjyear,Period From Gy_Kjrlb Where BeginFlag=1"
    Set Rec_Kjqj = Cw_DataEnvi.DataConnect.Execute(Sql_Kjqj)
    
    If Not Rec_Kjqj.EOF Then
        QyKjYear = Val(Rec_Kjqj.Fields("Kjyear"))
        QyPeriod = Val(Rec_Kjqj.Fields("Period"))
    End If
    
End Sub

'审核后将期初应收单数据输出到应收总帐中
Private Sub Sub_CheckBill()             '审 核
    '[>>
    
    Dim RecTemp As New ADODB.Recordset          '临时使用动态集
    Dim Lng_BillID As String                    '单据标识
    Dim RTemp As New ADODB.Recordset            '临时使用动态集
    Dim TempDB As New ADODB.Recordset           '临时使用动态集
    Dim RecTemp_Accsum As New ADODB.Recordset   '临时应收总帐动态集
    Dim Qstring As String                       '临时字符
    Dim TempJsq As Integer                      '临时计数器
    Dim Str_PSCode As String                    '往来单位编码
    Dim Str_DeptCode As String                  '部门编码
    Dim Str_PersonCode As String                '职员编码
    Dim Str_ForeignCurrCode As String           '原币编码

  
    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Or Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = "" Then
        Exit Sub
    End If
 
    '判断当前单据是否已审核,如已审核则不需再次审核
    If Not Fun_AllowEdit Then
        Tsxx = "已经审核或没有单据,不需审核!"
        Call Xtxxts(Tsxx, 0, 4)
        Exit Sub
    End If
 
    On Error GoTo Swcwcl
    
    Cw_DataEnvi.DataConnect.BeginTrans
     
        '标识期初应收单初始化完毕
        Cw_DataEnvi.DataConnect.Execute ("Update Gy_AccInformation Set ItemValue=1 Where ItemCode='Ar_CshWbBs'")
        Cw_DataEnvi.DataConnect.Execute ("Update RP_AccList Set Checker='" & Xtczy & "' Where StartFlag=1 and RPFlag='AR' and BillItemCode='20' and checker='' ")
        
        Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Select * From RP_AccList Where RPFlag='AR' and BillItemCode='20' and StartFlag=1 ")
        If RecTemp.EOF Then
            Tsxx = "期初应收单据已被其他人删除!"
            Call Xtxxts(Tsxx, 0, 4)
            Exit Sub
        End If
  
        '登记应收/应付总帐
        Do While Not RecTemp.EOF
            
            Str_PSCode = Trim(RecTemp.Fields("PSCode") & "")
            Str_DeptCode = Trim(RecTemp.Fields("DeptCode") & "")
            Str_PersonCode = Trim(RecTemp.Fields("PersonCode") & "")
            Str_ForeignCurrCode = Trim(RecTemp.Fields("ForeignCurrCode") & "")

            For TempJsq = 1 To QyPeriod
                With RecTemp_Accsum
                    If .State = 1 Then .Close
                    .Open "Select * From RP_AccSum Where RpFlag='Ar' And PSCode='" & Str_PSCode & _
                    "' And DeptCode='" & Str_DeptCode & "' And PersonCode='" & Str_PersonCode & _
                    "' And ForeignCurrCode='" & Str_ForeignCurrCode & "' And kjYear=" & QyKjYear & " And Period=" & TempJsq, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
                    
                    If Not RecTemp_Accsum.EOF Then
                       .Fields("YbNcye") = .Fields("YbNcye") + RecTemp.Fields("YbYsje")         '原币年初余额
                       .Fields("YbQcye") = .Fields("YbQcye") + RecTemp.Fields("YbYsje")         '原币期初余额
                       .Fields("BbNcye") = .Fields("BbNcye") + RecTemp.Fields("BbYsje")         '本币年初余额
                       .Fields("BbQcye") = .Fields("BbQcye") + RecTemp.Fields("BbYsje")         '本币期初余额
                       .Fields("YbQmye") = .Fields("YbQmye") + RecTemp.Fields("YbYsje")         '原币期末余额
                       .Fields("BbQmye") = .Fields("BbQmye") + RecTemp.Fields("BbYsje")         '本币期末余额
                       .Update
                    Else
                       .AddNew
                       .Fields("RPFlag") = "Ar"                                                 '应收应付标识
                       .Fields("PsCode") = Str_PSCode                                           '客户编码
                       .Fields("DeptCode") = Str_DeptCode                                       '部门编码
                       .Fields("PersonCode") = Str_PersonCode                                   '经办人
                       .Fields("ForeignCurrCode") = Str_ForeignCurrCode                         '币别
                       .Fields("KJYear") = QyKjYear                                             '会计年度
                       .Fields("Period") = TempJsq                                              '会计期间
                       .Fields("YbNcye") = RecTemp.Fields("YbYsje") + 0                         '原币年初余额
                       .Fields("YbQcye") = RecTemp.Fields("YbYsje")                             '原币期初余额
                       .Fields("BbNcye") = RecTemp.Fields("BbYsje") + 0                         '本币年初余额
                       .Fields("BbQcye") = RecTemp.Fields("BbYsje")                             '本币期初余额
                       .Fields("YbQmye") = RecTemp.Fields("YbYsje") + 0                         '原币期末余额
                       .Fields("BbQmye") = RecTemp.Fields("BbYsje")                             '本币期末余额

                       .Update
                    
                     End If
                    
                 End With
            Next TempJsq
            
            RecTemp.MoveNext
        Loop
  
    Cw_DataEnvi.DataConnect.CommitTrans
        
    '初始化完毕重新显示工具栏按钮
    Call Sub_CshToolBar
    
    '审核后刷新单据列表
    Call Sub_Query(0)
    Tsxx = "初始化完毕!"
    Call Xtxxts(Tsxx, 0, 4)

    Exit Sub

    '<<]

Swcwcl:
     Cw_DataEnvi.DataConnect.RollbackTrans
     Tsxx = "审核单据过程中出现未知错误,程序自动恢复审核前状态!"
     Call Xtxxts(Tsxx, 0, 1)
     Exit Sub
End Sub

Private Sub Sub_AbandonCheck()          '弃 审
   '[>>
  Dim RecTemp As New ADODB.Recordset     '临时使用动态集
  Dim Lng_BillID As String           '单据标识
  Dim RTemp As New ADODB.Recordset
  Dim TempDB As New ADODB.Recordset
  Dim Qstring As String
  '非数据行退出
  If CxbbGrid.Row < CxbbGrid.FixedRows Or Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = "" Then
     Exit Sub
  End If
 
  '判断当前单据是否已审核,如已审核则不需再次审核
  If Not Fun_AllowEditQs Then
     Tsxx = "已经全弃或没有单据,不需全弃!"
     Call Xtxxts(Tsxx, 0, 4)
     Exit Sub
  End If
 
  On Error GoTo Swcwcl
  
  Cw_DataEnvi.DataConnect.BeginTrans
     Cw_DataEnvi.DataConnect.Execute ("Update Ar_V_QcArNote Set Checker='' Where StartFlag=1 and RPFlag='AR' and BillitemCode like '2%'  ")
        '刷新放弃审核列表
        Call Sub_Query(0)
        Tsxx = "全弃完毕!"
        Call Xtxxts(Tsxx, 0, 4)
    
  Cw_DataEnvi.DataConnect.CommitTrans
  
  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 Sqlstr As String                   '查询字符串
    Dim Lng_BillID As String               '单据标识
    Lng_BillID = Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
    Sqlstr = "Select Checker From RP_AccList Where StartFlag=1 and RPFlag='AR' and BillItemCode = '20' and Checker='' "
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With RecTemp
        If .EOF Then
            Exit Function
        End If
    End With
    Fun_AllowEdit = True
End Function

Private Function Fun_AllowEditQs() As Boolean                      '判断当前单据是否全弃
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    Dim Sqlstr As String                   '查询字符串
    Dim Lng_BillID As String               '单据标识
    Lng_BillID = Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
    Sqlstr = "Select Checker From RP_AccList Where StartFlag=1 and RPFlag='AR' and BillItemCode like '2%' and Checker<>'' "
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With RecTemp
        If .EOF Then
            Exit Function
        End If
    End With
    Fun_AllowEditQs = True
End Function

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