VB开发的ERP系统

                yhAnswer = Xtxxts(Tsxx, 2, 2)
                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 If
    End With

End Sub

Private Sub Sub_AddBill()                                              '新增单据
    
    With Format_FrmOtherBill
       
        '设置单据处理为填制单据状态
        Xtcdcs = "1"
         
        .Show 1
    End With
       
    If Xtfhcs = "1" Then
        Tsxx = "期初应付单发生变化,是否刷新期初应付单列表?"
        yhAnswer = Xtxxts(Tsxx, 2, 2)
        
        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("009", GridStr(), Szzls))
        BbTotal = BbTotal - CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("010", 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("009", GridStr(), Szzls)) = YbTotal
            End If
            CxbbGrid.TextMatrix(CxbbGrid.Rows - 1, Sydz("010", 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='Ap_CshWbBs'")
        
        Cw_DataEnvi.DataConnect.Execute ("Update RP_AccList Set Checker='" & Xtczy & "' Where StartFlag=1 and RPFlag='AP' and BillItemCode='80' and checker='' ")
        
        Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Select * From RP_AccList Where RPFlag='AP' and BillItemCode='80' 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='Ap' 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") = "Ap"                                                 '应收应付标识
                        .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 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='AP' and BillItemCode = '80' 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 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