VB开发的ERP系统

    With Rec_Query
       CxbbGrid.Rows = CxbbGrid.FixedRows
       jsqte = CxbbGrid.FixedRows
       Do While Not .EOF
          If jsqte >= CxbbGrid.Rows Then
             CxbbGrid.AddItem ""
          End If
               '[>>自定义填充内容
            CxbbGrid.TextMatrix(jsqte, 0) = .Fields("InvoiceMainID")                                                 '收料通知单ID(主要用来查询定位用)
            
            If CxbbGrid.TextMatrix(jsqte, 0) <> CxbbGrid.TextMatrix(jsqte - 1, 0) Then
               Number = Number + 1
               CxbbGrid.TextMatrix(jsqte, 3) = Number
            Else
               CxbbGrid.TextMatrix(jsqte, 3) = CxbbGrid.TextMatrix(jsqte - 1, 3)
            End If
      '如果为同一张单据则不再输出制单日期和凭证号
''       If Trim(CxbbGrid.TextMatrix(jsqte - 1, 0)) <> Trim(Str(.Fields("InvoiceMainID"))) Then
            CxbbGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = Format(.Fields("InvoiceDate"), "yyyy-mm-dd")
            CxbbGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("InvoiceNum") & "")
            CxbbGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("InvoiceNumZs") & "")
            CxbbGrid.TextMatrix(jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("InvoiceName") & "")
            CxbbGrid.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("SupplierName") & "")
            CxbbGrid.TextMatrix(jsqte, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("DeptName") & "")
            CxbbGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("PersonName") & "")
            CxbbGrid.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)) = Trim(.Fields("OrderFormNum") & "")
            CxbbGrid.TextMatrix(jsqte, Sydz("009", GridStr(), Szzls)) = Trim(.Fields("PurTypeName") & "")
            CxbbGrid.TextMatrix(jsqte, Sydz("010", GridStr(), Szzls)) = Trim(.Fields("SSName") & "")
            
            CxbbGrid.TextMatrix(jsqte, Sydz("011", GridStr(), Szzls)) = Trim(.Fields("Payname") & "")
            CxbbGrid.TextMatrix(jsqte, Sydz("012", GridStr(), Szzls)) = Trim(.Fields("TransferWayName") & "")
            CxbbGrid.TextMatrix(jsqte, Sydz("013", GridStr(), Szzls)) = Trim(.Fields("ForeignCurrName") & "")
            CxbbGrid.TextMatrix(jsqte, Sydz("014", GridStr(), Szzls)) = IIf(IsNull(.Fields("AccRate")) Or .Fields("AccRate") = 0, "", .Fields("AccRate").Value)
            CxbbGrid.TextMatrix(jsqte, Sydz("015", GridStr(), Szzls)) = Trim(.Fields("ChargeDeptName") & "")
                        
            CxbbGrid.TextMatrix(jsqte, Sydz("016", GridStr(), Szzls)) = Trim(.Fields("Remark") & "")
            CxbbGrid.TextMatrix(jsqte, Sydz("017", GridStr(), Szzls)) = Trim(.Fields("Maker") & "")
            CxbbGrid.TextMatrix(jsqte, Sydz("018", GridStr(), Szzls)) = Trim(.Fields("Checker") & "")
            CxbbGrid.TextMatrix(jsqte, Sydz("019", GridStr(), Szzls)) = Format(.Fields("BanlanceDate"), "yyyy-mm-dd") 'Trim(.Fields("BanlanceDate") & "") 'remonstrate
''      End If
            CxbbGrid.TextMatrix(jsqte, Sydz("021", GridStr(), Szzls)) = Trim(.Fields("MNumber") & "")
            CxbbGrid.TextMatrix(jsqte, Sydz("022", GridStr(), Szzls)) = Trim(.Fields("MName") & "")
            CxbbGrid.TextMatrix(jsqte, Sydz("023", GridStr(), Szzls)) = Trim(.Fields("Model") & "")
            CxbbGrid.TextMatrix(jsqte, Sydz("024", GridStr(), Szzls)) = Trim(.Fields("PurUnitName") & "")
            CxbbGrid.TextMatrix(jsqte, Sydz("025", GridStr(), Szzls)) = IIf(IsNull(.Fields("Quantity")) Or .Fields("Quantity") = 0, "", .Fields("Quantity").Value)
            CxbbGrid.TextMatrix(jsqte, Sydz("026", GridStr(), Szzls)) = IIf(IsNull(.Fields("PriceYb")) Or .Fields("PriceYb") = 0, "", .Fields("PriceYb").Value)
            CxbbGrid.TextMatrix(jsqte, Sydz("027", GridStr(), Szzls)) = IIf(IsNull(.Fields("MoneyYb")) Or .Fields("MoneyYb") = 0, "", .Fields("MoneyYb").Value)
            CxbbGrid.TextMatrix(jsqte, Sydz("028", GridStr(), Szzls)) = IIf(IsNull(.Fields("PriceBb")) Or .Fields("PriceBb") = 0, "", .Fields("PriceBb").Value)
            CxbbGrid.TextMatrix(jsqte, Sydz("029", GridStr(), Szzls)) = IIf(IsNull(.Fields("MoneyBb")) Or .Fields("MoneyBb") = 0, "", .Fields("MoneyBb").Value)
            CxbbGrid.TextMatrix(jsqte, Sydz("020", GridStr(), Szzls)) = Trim(.Fields("PurSortName") & "")
            '<<]
            '设置数据行高度(Fixed)
            CxbbGrid.RowHeight(jsqte) = Sjhgd
     
            '动态集指针加1,同时将计数器加1(Fixed)
            .MoveNext
            jsqte = jsqte + 1
        Loop
    End With

''''''''''
''''''''''''''''''''''''''''''''''''remonstrate 加
''''''''''    If Not CxbbGrid.Rows > CxbbGrid.FixedRows Then Exit Sub
''''''''''
''''''''''    '判断是否输出合计
'''''''''''    If Qcsj_Frmqcsjcxtj.Chk_Sum.Value = 1 Then
''''''''''       CxbbGrid.BackColorAlternate = &H80000005
''''''''''       CxbbGrid.Subtotal flexSTSum, 0, Sydz("020", GridStr(), Szzls), , &HF7F3EC, , , "合计"
''''''''''       CxbbGrid.Subtotal flexSTSum, 0, Sydz("022", GridStr(), Szzls), , &HF7F3EC, , , "合计"
'''''''''''       CxbbGrid.ExplorerBar = flexExMove
'''''''''''    Else
'''''''''''       CxbbGrid.BackColorAlternate = &HF7F3EC
'''''''''''       CxbbGrid.ExplorerBar = flexExSortAndMove
'''''''''''    End If
''''''''''
''''''''''    '调整网格
''''''''''    For jsqte = CxbbGrid.FixedRows To CxbbGrid.Rows - 1
''''''''''      CxbbGrid.RowHeight(jsqte) = Sjhgd
''''''''''      If CxbbGrid.TextMatrix(jsqte, 0) = "合计" Then
''''''''''         CxbbGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = "  合计"
''''''''''         CxbbGrid.TextMatrix(jsqte, 0) = CxbbGrid.TextMatrix(jsqte - 1, 0)
''''''''''      End If
''''''''''    Next jsqte
''''''''''    ']以上为用户自定义部分


End Sub

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

    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
        Exit Sub
    End If

    Sqlstr = "SELECT InvoiceMainID From Cg_InvoiceMain Where InvoiceMainID=" & 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 cg_invloiceBill
                
                '填充查询单据标识
                XT_BillID = CxbbGrid.TextMatrix(CxbbGrid.Row, 0)
                Xtcdcsfz = Str_QueryCondi
                .InvoiceType = 1  '期初普通发票标识
                '设置单据处理为列表查询(修改)状态
                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()                                              '新增单据
   
    With cg_invloiceBill
   
        '设置单据处理为填制单据状态
        Xtcdcs = "1"
        .InvoiceType = 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 Cg_PurPlanSub Where InvoiceMainID=" & Lng_BillID)         '删除单据子表内容
        Cw_DataEnvi.DataConnect.Execute ("Delete Cg_InvoiceMain Where InvoiceMainID=" & Lng_BillID)        '删除单据主表内容
        Cw_DataEnvi.DataConnect.CommitTrans
      
        '删除网格中单据数据
        jsqte = CxbbGrid.FixedRows
        Do While jsqte <= CxbbGrid.Rows - 1
            If Val(CxbbGrid.TextMatrix(jsqte, 0)) = Lng_BillID Then
                CxbbGrid.RemoveItem (CxbbGrid.Row)
            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_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 ,ltrim(rtrim(isnull(ChalkitupMan,''))) as ChalkitupMan ,BanlanceDate From Cg_InvoiceMain Where InvoiceMainID=" & 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
            If Trim("" & .Fields("BanlanceDate")) <> "" Then
                Tsxx = "该单据已结算,不能删除!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            End If
        End If
    End With
    Fun_AllowDelete = 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