VB开发的ERP系统

                CxbbGrid.TextMatrix(Jsqte, Sydz("014", GridStr(), Szzls)) = .Fields("Quan")
            End If
            If .Fields("PlanPrice") <> 0 Then                                                                            '单价
                CxbbGrid.TextMatrix(Jsqte, Sydz("015", GridStr(), Szzls)) = .Fields("PlanPrice")
            End If
            If .Fields("PlanMoney") <> 0 Then                                                                       '数量
                CxbbGrid.TextMatrix(Jsqte, Sydz("016", GridStr(), Szzls)) = .Fields("PlanMoney")
            End If
            If .Fields("Price") <> 0 Then                                                                         '总重
                CxbbGrid.TextMatrix(Jsqte, Sydz("017", GridStr(), Szzls)) = .Fields("Price")
            End If
            If .Fields("Emoney") <> 0 Then                                                                       '金额
                CxbbGrid.TextMatrix(Jsqte, Sydz("018", GridStr(), Szzls)) = .Fields("EMoney")
            End If
            
            '<<]
            '设置数据行高度(Fixed)
            CxbbGrid.RowHeight(Jsqte) = Sjhgd
     
            '动态集指针加1,同时将计数器加1(Fixed)
            .MoveNext
            Jsqte = Jsqte + 1
        Loop
    End With
    
    '输入合计
    With CxbbGrid
        If Start_BillListCond.Chk_Sum.Value = 1 Then
           .SubtotalPosition = flexSTBelow
           For Jsqte = Qslz To .Cols - 1
                If GridBoolean(Jsqte, 4) Then
                     .Subtotal flexSTSum, 0, Jsqte, , &HF7F3EC, , , , , True
                End If
           Next
           
           For Jsqte = .FixedRows To .Rows - 1
                If .IsSubtotal(Jsqte) Then
                    For Coljsq = Qslz To .Cols - 1
                        If Val(.TextMatrix(Jsqte, Coljsq)) = 0 And GridBoolean(Coljsq, 4) Then
                            .TextMatrix(Jsqte, Coljsq) = ""
                        End If
                    Next
                    .TextMatrix(Jsqte, 0) = .TextMatrix(Jsqte - 1, 0)
                    .TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = "    合计 "
                    .RowHeight(Jsqte) = Sjhgd
                End If
           Next
        End If
    End With
    
    ']以上为用户自定义部分

End Sub

Private Sub CxbbGrid_DblClick()                                              '用户双击网格调入相应单据
    
    Dim Rectemp As New ADODB.Recordset               '临时使用动态集

    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

    SqlStr = "SELECT StartInputMainId From Chhs_StartInputMain Where StartInputMainId=" & 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 Start_BillInput
                
                '填充查询单据标识
                XT_BillID = CxbbGrid.TextMatrix(CxbbGrid.Row, 0)
                Xtcdcsfz = Str_QueryCondi
                
                '设置单据处理为列表查询(修改)状态
                Xtcdcs = "2"
                
                .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 If
    End With

End Sub

Private Sub Sub_AddBill()                                              '新增单据
Dim Rectemp As Recordset
Dim mYear As Integer

    mYear = PGKjYear
    
    If Xtyear <> mYear Then
        Tsxx = "操作日期不在当前会计年度(" + Trim(Str(mYear)) + "),请重新登录!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    End If
    
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select * from gy_kjrlb where kjyear=" & mYear & " and beginflag=1")
    If Rectemp.EOF Then
        Tsxx = "非开帐年度,不允许期初单据录入!"
        Call Xtxxts(Tsxx, 0, 4)
        Exit Sub
    Else
        If Xtmm <> StartMon Then
            If Not Rectemp.Fields("chhsjzbz") Then
                Tsxx = "操作日期不在当前会计期间(" + Trim(Str(mYear)) + "." + Trim(Str(StartMon)) + "),请重新登录!"
                Call Xtxxts(Tsxx, 0, 1)
                Exit Sub
            Else
                If Rectemp.Fields("chhsjzbz") Then
                    Tsxx = "非开帐月份,不允许期初单据录入!"
                    Call Xtxxts(Tsxx, 0, 1)
                    Exit Sub
                End If
            End If
        Else
            If Rectemp.Fields("chhsjzbz") Then
                Tsxx = "开帐月份已结帐,不允许期初单据录入!"
                Call Xtxxts(Tsxx, 0, 1)
                Exit Sub
            End If
        End If
    End If
    
    Set Rectemp = Nothing
     
    With Start_BillInput
   
        '设置单据处理为填制单据状态
        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.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 Chhs_StartInputSub Where StartInputMainId=" & Lng_BillID)         '删除单据子表内容
        Cw_DataEnvi.DataConnect.Execute ("Delete Chhs_StartInputMain Where StartInputMainId=" & Lng_BillID)        '删除单据主表内容
        Cw_DataEnvi.DataConnect.CommitTrans
      
        '删除网格中单据数据
        Jsqte = CxbbGrid.FixedRows
        Do While Jsqte <= CxbbGrid.Rows - 1
            Jsqte = CxbbGrid.FindRow(Lng_BillID, Jsqte, 0)
            If Jsqte > 0 Then
                CxbbGrid.RemoveItem (Jsqte)
            Else
                Exit Do
            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_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,ChalkitupMan From Chhs_StartInputMain Where StartInputMainId=" & Lng_BillID
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    With Rectemp
        If Not .EOF Then
            If Trim(.Fields("Checker") & "") <> "" Or Trim(.Fields("ChalkitupMan") & "") <> "" Then
                Tsxx = "该期初单据已审核或已记帐,不能删除!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            End If
            End If
    End With
    Fun_AllowDelete = True
  
End Function
Private Sub Sub_ToolBar()          '设置工具条按钮
    
    '无查询记录时，单据和删除按钮不可选
    With SzToolbar
        If CxbbGrid.Rows = CxbbGrid.FixedRows Then
            .Buttons("Bill").Enabled = False
            .Buttons("sc").Enabled = False
        Else
            .Buttons("Bill").Enabled = True
            .Buttons("sc").Enabled = True
        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