VB开发的ERP系统

    '以下为文本框处理程序(Fixed)
    TextGroupCode = "Kf_Autobalance"
    Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())  '读入文本框录入信息
    Call Wbkcsh
    
    '[>>初始化查询条件默认值
    LrText(0).Text = Format(CDate(Xtrq), "yyyy-mm-dd")
    LrText(1).Text = Format(CDate(Xtrq), "yyyy-mm-dd")

    '<<]
    
End Sub


Private Sub QdCommand_Click()                                   '确 定
    
    '录入条件有效性判断(Fixed)
    If Not Lrtjyxxpd Then
        Exit Sub
    End If
    '<<]

    Bln_ClrkdKfsc = Fun_ClrkdKfsc ''材料入库单是不是由库房生成
    Call FilterCondition
    If Check_InoutMain Then
        Call Autobalance
    End If
End Sub
Private Sub Autobalance()
    Dim int_temp As Long
    Dim rst_temp As New ADODB.Recordset
    Dim str_sqlTemp As String
    Dim str_SqlInOut As String
    Dim Rst_Invoice As New ADODB.Recordset
    Dim Rst_InOut As New ADODB.Recordset
    Dim int_InvoiceMainID As Integer
    Dim int_FrmHeight As Integer
On Error GoTo Swcwcl
    Cw_DataEnvi.DataConnect.BeginTrans
    

    Set Rst_Invoice = Cw_DataEnvi.DataConnect.Execute("select InvoiceMainID, CgBalanceCode, InvoiceDate, SupplierCode, MNumber, InvSortcode from kf_V_BalanceCG " & FilterInvoice)
    If Rst_Invoice.RecordCount = 0 Then
        Tsxx = "没有可以结算的发票数据!"
        Call Xtxxts(Tsxx, 0, 4)
        Rst_Invoice.Close
        Set Rst_Invoice = Nothing
        Cw_DataEnvi.DataConnect.RollbackTrans
        Exit Sub
    End If
    int_FrmHeight = Me.Height
    Me.Height = 1785
    Me.Frame1.Visible = False
    Me.Refresh
    Me.ProgressBar.Max = Rst_Invoice.RecordCount + 1
    Me.ProgressBar.Value = 0
    Me.Frame2.Visible = True
    Me.Refresh
    
    Rst_Invoice.MoveFirst
    int_InvoiceMainID = Rst_Invoice.Fields("InvoiceMainID").Value
    int_temp = 0
    Int_InvoiceSubNumber = 0
    ReDim Collect_BalanceRelation(0) As New Collection
    With Rst_Invoice
        Do While Not .EOF    '结算过程
              Me.ProgressBar.Value = Me.ProgressBar.Value + 1
              Me.Label2.Caption = Label2.Caption & ".."
              str_SqlInOut = "SELECT Gy_InOutMain.InOutMainId,Gy_InOutSub.InOutSubId ,Gy_InOutMain.WhCode " & _
                                " FROM Gy_InOutMain INNER JOIN " & _
                                      " Gy_InOutSub ON Gy_InOutMain.InOutMainId = Gy_InOutSub.InOutMainId INNER JOIN" & _
                                      " Gy_Material ON Gy_InOutSub.MNumber = Gy_Material.MNumber" & _
                                " WHERE (Gy_InOutSub.BalanceDate IS NULL) AND (LTRIM(RTRIM(Gy_InOutMain.BillCode)) " & _
                                      " = '1201' or LTRIM(RTRIM(Gy_InOutMain.BillCode))='1211' ) AND (LTRIM(RTRIM(ISNULL(Gy_InOutMain.SupplierCode, ''))) " & _
                                      " + '#' + LTRIM(RTRIM(ISNULL(Gy_InOutSub.MNumber, ''))) " & _
                                      " + '$' + LTRIM(RTRIM(CONVERT(char(40), CONVERT(decimal(18, 6), " & _
                                      " Gy_InOutSub.FactReceiptQuan)))) = '" & Trim("" & Rst_Invoice.Fields("CgBalanceCode")) & "')  " & FilterRKD
            Set Rst_InOut = Cw_DataEnvi.DataConnect.Execute(str_SqlInOut)
                If Rst_InOut.RecordCount <> 0 Then
                     If int_InvoiceMainID <> Rst_Invoice.Fields("InvoiceMainID").Value Then
                        Bln_HaveErr = False
                        Call Creat_BalanceBill    ''生成结算单
                        If Bln_HaveErr = True Then GoTo Errexec
                        Me.Label2.Caption = "正在进行数据处理..."
                        ReDim Collect_BalanceRelation(0) As New Collection
                        int_InvoiceMainID = Rst_Invoice.Fields("InvoiceMainID").Value
                        int_temp = 1
                        ReDim Preserve Collect_BalanceRelation(int_temp) As New Collection
                        Collect_BalanceRelation(int_temp).Add str(int_InvoiceMainID)
                        Collect_BalanceRelation(int_temp).Add str(Rst_InOut.Fields("InOutMainId"))
                        Collect_BalanceRelation(int_temp).Add str(Rst_InOut.Fields("InOutSubId"))
                     Else
                        int_temp = int_temp + 1
                        ReDim Preserve Collect_BalanceRelation(int_temp) As New Collection
                        Collect_BalanceRelation(int_temp).Add str(int_InvoiceMainID)
                        Collect_BalanceRelation(int_temp).Add str(Rst_InOut.Fields("InOutMainId"))
                        Collect_BalanceRelation(int_temp).Add str(Rst_InOut.Fields("InOutSubId"))
                     End If
                End If
            int_InvoiceMainID = Rst_Invoice.Fields("InvoiceMainID").Value
            Rst_Invoice.MoveNext
        Loop
            Bln_HaveErr = False
            Call Creat_BalanceBill    ''生成结算单
            If Bln_HaveErr = True Then GoTo Errexec
            ReDim Collect_BalanceRelation(0) As New Collection
            int_temp = 1
             Me.ProgressBar.Value = Me.ProgressBar.Value + 1
    End With
    Cw_DataEnvi.DataConnect.CommitTrans
    Me.Label2.Caption = "数据处理完成!"
    Tsxx = "自动结算完成!"
    Call Xtxxts(Tsxx, 0, 4)
Errexec:
    Me.Frame2.Visible = False
    Me.Height = int_FrmHeight
    Me.Frame1.Visible = True
    Me.Refresh
    Exit Sub
Swcwcl:
    Cw_DataEnvi.DataConnect.RollbackTrans
End Sub
Private Sub Creat_BalanceBill()
    Dim int_temp As Long
    Dim str_sqlTemp As String
    Dim rst_temp As New ADODB.Recordset
    Dim Bln_BalanceOK As Boolean
    Dim str_WhCode As String
    Dim banl_MainRecordset As New ADODB.Recordset
    Dim banl_SubRecordset As New ADODB.Recordset
    Dim rst_BalanceRelation  As New ADODB.Recordset
    Dim Rkd_MainRecordset As New ADODB.Recordset
    Dim Rkd_subRecordset As New ADODB.Recordset
On Error GoTo Swcwcl
    Dim banl_Mainid As Integer
    Dim RKd_MainId As Integer
    Bln_BalanceOK = False
    If UBound(Collect_BalanceRelation) <> 0 Then
        str_sqlTemp = "SELECT B.InvoiceMainID, A.SupplierCode, B.MNumber,  " & _
                              " B.Quantity * (C.PurInvCon1 / C.PurInvCon2) AS Quantity, A.DeptCode, A.PersonCode,  " & _
                              " B.IsCharge, B.InvoiceSubID,  " & _
                              " B.MoneyBb / (B.Quantity * (C.PurInvCon1 / C.PurInvCon2)) AS PriceBb ,B.TotalMoneyBb,B.TaxMoneyBb  " & _
                        " FROM Cg_InvoiceMain A INNER JOIN  " & _
                              " Cg_InvoiceSub B ON A.InvoiceMainID = B.InvoiceMainID INNER JOIN  " & _
                              " Gy_Material C ON B.MNumber = C.MNumber" & _
                              " WHERE (A.InvoiceMainID =" & Val(Collect_BalanceRelation(1).Item(1)) & ")"
        Set rst_temp = Cw_DataEnvi.DataConnect.Execute(str_sqlTemp)
        If rst_temp.RecordCount = UBound(Collect_BalanceRelation) Then
             rst_temp.MoveFirst
                 With banl_MainRecordset
                     If .State = 1 Then .Close
                     .Open "select * from Kf_BalanceMain where 2=1 ", Cw_DataEnvi.DataConnect, adOpenForwardOnly, adLockOptimistic
                     .AddNew
                     .Fields("BalanceMainId") = CreatBillID("1210")
                     .Fields("BillNum") = CreatBillCode("1210", True)
                     .Fields("BillCode") = "1210"
                     If Trim("" & rst_temp.Fields("SupplierCode")) <> "" Then
                     .Fields("SupplierCode") = Trim("" & rst_temp.Fields("SupplierCode"))
                     End If
                     .Fields("opertype") = "库房结算"
                     If Trim("" & rst_temp.Fields("DeptCode")) <> "" Then
                         .Fields("DeptCode") = Trim("" & rst_temp.Fields("DeptCode"))
                     End If
                     If Trim("" & rst_temp.Fields("PersonCode")) <> "" Then
                        .Fields("PersonCode") = Trim("" & rst_temp.Fields("PersonCode"))
                     End If
                     .Fields("Maker") = Xtczy
                     .Fields("BillDate") = CDate(Xtrq)
                     .Fields("KjYear") = Xtyear
                     .Fields("Period") = Xtmm
                     .Fields("BanlType") = "1"
                     .Update
                     banl_Mainid = .Fields("BalanceMainId")
                 End With
            For int_temp = 1 To rst_temp.RecordCount
                 With banl_SubRecordset
                     If .State = 1 Then .Close
                     .Open "select * from Kf_BalanceSub where 2=1 ", Cw_DataEnvi.DataConnect, adOpenForwardOnly, adLockOptimistic
                     .AddNew
                     .Fields("BalanceMainId") = banl_Mainid
                     .Fields("BalanceSubId") = rst_temp.Fields("InvoiceSubID")
                     .Fields("MNumber") = rst_temp.Fields("MNumber")
                     .Fields("Quan") = rst_temp.Fields("Quantity")
                     .Fields("Price") = rst_temp.Fields("PriceBb")
                     .Fields("EMoney") = rst_temp.Fields("TotalMoneyBb")
                     .Fields("TaxMoney") = rst_temp.Fields("TaxMoneyBb")
                     .Fields("TotalMoney") = rst_temp.Fields("TaxMoneyBb") + rst_temp.Fields("TotalMoneyBb")
                     .Update
                 End With
                 rst_temp.MoveNext
            Next int_temp
            For int_temp = 1 To UBound(Collect_BalanceRelation)
                With rst_BalanceRelation
                    If .State = 1 Then .Close
                    .Open "select * from Kf_BalanceRelation where 2=1 ", Cw_DataEnvi.DataConnect, adOpenForwardOnly, adLockOptimistic
                    .AddNew
                    .Fields("BalanceMainId") = banl_Mainid
                    .Fields("InvoiceMainID") = Val(Collect_BalanceRelation(int_temp).Item(1))
                    .Fields("InOutMainId") = Val(Collect_BalanceRelation(int_temp).Item(2))
                    .Fields("InOutSubId") = Val(Collect_BalanceRelation(int_temp).Item(3))
                    .Update
                End With
            Next int_temp
            Cw_DataEnvi.DataConnect.Execute (" Kf_Sp_BalanceRelation  " & banl_Mainid)
            Bln_BalanceOK = True
        End If
    End If
        If Bln_BalanceOK = False Then Exit Sub
        
        If Bln_ClrkdKfsc = True Then
            Dim str_InsertSql As String
                Set rst_BalanceRelation = Cw_DataEnvi.DataConnect.Execute("SELECT InOutMainId From Kf_BalanceRelation Where (BalanceMainId = " & banl_Mainid & " ) GROUP BY InOutMainId")
                If rst_BalanceRelation.RecordCount <> 0 Then
                    Do While Not rst_BalanceRelation.EOF
                        Set rst_temp = Cw_DataEnvi.DataConnect.Execute("SELECT WhCode  FROM Gy_InOutMain where InOutMainId= " & rst_BalanceRelation.Fields("InOutMainId"))
                        If rst_temp.RecordCount <> 0 Then
                            rst_temp.MoveFirst
                            str_WhCode = Trim("" & rst_temp.Fields(0))
                        Else
                            Tsxx = "结算过程中某单据发生变化,结算失败!"
                            Call Xtxxts(Tsxx, 0, 1)
                            GoTo Swcwcl
                        End If
                         RKd_MainId = CreatBillID("1212")
                         str_InsertSql = " INSERT INTO Gy_InOutMain " & _
                              " (InOutMainId, BillCode, BillNum, WhCode, InoutFlag, PurTypeCode, OperType,  " & _
                              " OperbillNum, BillDate, InoutClassCode, TranCompanyCode, TransferWayCode, " & _
                              " BusNum, DeptCode, PersonCode, CusCode, SupplierCode,   " & _
                              " ConsignbillNum, Consignbillid, KfChecker , Maker, KjYear, Period,BanlanceId) " & _
                        " SELECT " & RKd_MainId & " ,'1212', '" & CreatBillCode("1212", True, Xtyear, Xtmm, str_WhCode) & "', WhCode, InoutFlag, PurTypeCode, OperType, " & _
                              " OperbillNum, convert(datetime,'" & Xtrq & "'), InoutClassCode, TranCompanyCode, TransferWayCode, " & _
                              " BusNum, DeptCode, PersonCode, CusCode, SupplierCode,  " & _
                              " ConsignbillNum , Consignbillid, '" & Xtczy & "','" & Xtczy & "', " & Xtyear & ", " & Xtmm & "," & banl_Mainid & _
                        " From Gy_InOutMain " & _
                        " Where (InOutMainId =" & rst_BalanceRelation.Fields("InOutMainId") & ")"
                        Cw_DataEnvi.DataConnect.Execute (str_InsertSql)
                        str_InsertSql = "INSERT INTO Gy_InOutSub " & _
                                              " (InOutSubId, InOutMainId, MNumber, FactReceiptQuan, Price, EMoney, EvaluationMoney,  " & _
                                              " PlanPrice, PlanMoney) " & _
                                        " SELECT InOutSubId, " & RKd_MainId & ", MNumber, FactReceiptQuan, Price, EMoney, EvaluationMoney, " & _
                                              " PlanPrice, PlanMoney" & _
                                        " From Gy_InOutSub " & _
                                        " WHERE (InOutMainId = " & rst_BalanceRelation.Fields("InOutMainId") & ") AND (InOutSubId IN " & _
                                                  " (SELECT InOutSubId " & _
                                                 " From Kf_BalanceRelation " & _
                                                 " WHERE BalanceMainId = " & banl_Mainid & " AND InOutMainId = " & rst_BalanceRelation.Fields("InOutMainId") & "))"
                       Cw_DataEnvi.DataConnect.Execute (str_InsertSql)
                    rst_BalanceRelation.MoveNext
                    Loop
                Else
                    Tsxx = "结算过程中某单据发生变化,结算失败!"
                    Call Xtxxts(Tsxx, 0, 1)
                    GoTo Swcwcl
                End If
        End If
Exit Sub
Swcwcl:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Bln_HaveErr = True
End Sub
Private Function Check_InoutMain() As Boolean  '是否有可以结算的入库单
    Dim int_temp As Long
    Dim rst_temp As New ADODB.Recordset
    Dim str_sqlTemp As String
    str_sqlTemp = "SELECT Gy_InOutMain.InOutMainId " & _
                    " FROM Gy_InOutMain INNER JOIN " & _
                          " Gy_InOutSub ON Gy_InOutMain.InOutMainId = Gy_InOutSub.InOutMainId INNER JOIN" & _
                            " Gy_Material ON Gy_InOutSub.MNumber = Gy_Material.MNumber" & _
                    " WHERE (Gy_InOutSub.BalanceDate IS NULL and (ltrim(rtrim(isnull(Gy_InOutMain.kfChecker,''))) <>'')  AND (ltrim(rtrim(Gy_InOutMain.BillCode))='1211' or ltrim(rtrim(Gy_InOutMain.BillCode))='1201'))  " & FilterInOut
    Set rst_temp = Cw_DataEnvi.DataConnect.Execute(str_sqlTemp)
    If rst_temp.RecordCount <> 0 Then
        Check_InoutMain = True
    Else
        Tsxx = "没有可以结算的入库单数据!"
        Call Xtxxts(Tsxx, 0, 4)
        Check_InoutMain = False
    End If
    rst_temp.Close
    Set rst_temp = Nothing
End Function
Private Sub FilterCondition()
Dim Jsqte As Integer
    FilterInvoice = " where 1=1 "
    FilterRKD = " "
    FilterInOut = " "
    For Jsqte = 1 To 5
    Select Case Jsqte
        Case 1  '查询日期范围(起始)
            If Trim(LrText(0).Text) <> "" Then
                FilterInvoice = FilterInvoice & " And InvoiceDate>=convert(datetime,'" & Trim(LrText(0).Text) & "')"