VB开发的ERP系统

    Query_Cond = "(" & Query_Cond & ")"
    AvgQuery_Cond = "(" & AvgQuery_Cond & ")"
    PlanQuery_Cond = "(" & PlanQuery_Cond & ")"
    MoveQuery_Cond = "(" & MoveQuery_Cond & ")"
 
    Now_period = PGNowmon

    '判断单据是否全部记帐
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute("SELECT chhsjzbz FROM GY_kjrlb WHERE KjYear='" & PGKjYear & "' and Period='" & Now_period & "'")
    If Not Rectemp.EOF Then
        If Rectemp.Fields("chhsjzbz") Then
            Tsxx = "当前会计期间已结帐,不允许恢复期末处理!"
            Call Xtxxts(Tsxx, 0, 1)
            Exit Sub
        End If
    End If
    
    '是否有单据已生成凭证
    For Jsqte = 0 To Lst_Cklb(1).ListCount - 1
        If Lst_Cklb(1).Selected(Jsqte) Then
            SqlStr = "SELECT Vouchid,WhName FROM Chhs_V_List WHERE WhCode='" & WH_codefz(Jsqte) & "' AND Period='" & Now_period & "' AND Vouchid<>0"
            Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
            
            If Not Rectemp.EOF Then
                Tsxx = Trim(Rectemp.Fields("WhName")) + "中有部分单据已生成凭证，不允许恢复期末处理!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Sub
            End If
        End If
    Next Jsqte
 
    Tsxx = "是否进行恢复期末处理?"
    Msg = Xtxxts(Tsxx, 1, 2)
    If Not Msg = 6 Then Exit Sub
 
    Label1.Visible = True
    Label1.Refresh
 
    Cw_DataEnvi.DataConnect.BeginTrans
    
    '恢复期末处理
    For Jsqte = 0 To Lst_Cklb(1).ListCount - 1
    
        If Lst_Cklb(1).Selected(Jsqte) Then
            
            '修改收发记录出库金额 单价
            If Wh_Pricemodefz(Jsqte) = "全月平均法" Then
                
                SqlStr = "SELECT InoutMainId,InoutSubId FROM Chhs_List WHERE WhCode='" & WH_codefz(Jsqte) & "' AND Period='" & Now_period & "' " & _
                         "AND KjYear='" & PGKjYear & "' AND InOutFlag=0 and SfjeztFlag=0 "
                Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                
                Do While Not Rectemp.EOF
                    SqlStr = "UPDATE GY_InOutSub set IssueMoney=0,Price=0 WHERE InoutMainId='" & Rectemp.Fields("InoutMainId") & "' AND InoutSubId='" & Rectemp.Fields("InoutSubId") & "'"
                    Cw_DataEnvi.DataConnect.Execute (SqlStr)
                    Rectemp.MoveNext
                Loop
                
            End If
                
            If Wh_Pricemodefz(Jsqte) = "全月平均法" Then
            
                '修改明细帐的出库单价金额
                SqlStr = "UPDATE Chhs_List SET OutPrice=0 ,OutMoney=0 " & _
                         "WHERE WhCode='" & WH_codefz(Jsqte) & "' AND Period='" & Now_period & "' " & _
                         "AND KjYear='" & PGKjYear & "' and SfjeztFlag=0  and InOutFlag=0 and BillCode<>'1302'"
                Cw_DataEnvi.DataConnect.Execute (SqlStr)
                
            Else
                If Wh_Pricemodefz(Jsqte) = "计划价法" Then
             
                    '删除差异结转单
                    SqlStr = "DELETE Chhs_Diffbill WHERE WhCode='" & WH_codefz(Jsqte) & "' AND KjYear='" & PGKjYear & "' and Period='" & Now_period & "'"
                    Cw_DataEnvi.DataConnect.Execute (SqlStr)
             
                    '删除明细帐中差异结转单
                     SqlStr = "DELETE Chhs_List WHERE WhCode='" & WH_codefz(Jsqte) & "' " & _
                             "AND Period='" & Now_period & "'  and KjYear='" & PGKjYear & "'and BillCode='1307'"
                     Cw_DataEnvi.DataConnect.Execute (SqlStr)
            
                 End If
            End If
            
            '删除明细帐中下月红字回冲单
            If PGNowmon = LastMon Then
                SqlStr = "DELETE Chhs_List WHERE WhCode='" & WH_codefz(Jsqte) & "' AND Period=1 AND KjYear='" & PGKjYear + 1 & "' and BillCode='1305' "
            Else
                SqlStr = "DELETE Chhs_List WHERE startflag=0 and WhCode='" & WH_codefz(Jsqte) & "' AND Period='" & Now_period + 1 & "' AND KjYear='" & PGKjYear & "' and BillCode='1305' "
            End If
            Cw_DataEnvi.DataConnect.Execute (SqlStr)
        
            '删除明细帐中蓝字暂估单
            SqlStr = "DELETE Chhs_List WHERE startflag=0 and WhCode='" & WH_codefz(Jsqte) & "' " & _
                     "AND Period='" & Now_period & "' AND KjYear='" & PGKjYear & "' and BillCode='1304' "
            Cw_DataEnvi.DataConnect.Execute (SqlStr)
            
            '清空收发记录采购入库单中记帐人
            SqlStr = "UPDATE GY_InOutMain SET ChalkitupMan='' WHERE WhCode='" & WH_codefz(Jsqte) & "' " & _
                     "AND Period='" & Now_period & "' AND KjYear='" & PGKjYear & "' and BillCode='1201' "
            Cw_DataEnvi.DataConnect.Execute (SqlStr)
        
            '修改期末处理月份
            SqlStr = "UPDATE GY_WareHouse SET EndDealFlagChhs=0 WHERE WhCode='" & WH_codefz(Jsqte) & "'"
            Cw_DataEnvi.DataConnect.Execute (SqlStr)
        End If
    Next Jsqte
                
    '调整总帐
    Call Tzzz
  
    '恢复物料表中填写出库成本
    Call ReturnNewOutCost
  
    Cw_DataEnvi.DataConnect.CommitTrans
  
    '刷新列表框
    Call AddWarehouseName

    Tsxx = "恢复期末处理完毕!"
    Call Xtxxts(Tsxx, 0, 4)
  
    Label1.Visible = False
  
    Exit Sub
  
Error:

    Cw_DataEnvi.DataConnect.RollbackTrans
    Label1.Visible = False
    Tsxx = "恢复期末处理失败!"
    Call Xtxxts(Tsxx, 0, 1)
  
End Sub

Private Sub Com_Qbfd_Click(Index As Integer) '全部否定
 
    For Jsqte = 0 To Lst_Cklb(Index).ListCount - 1
        Lst_Cklb(Index).Selected(Jsqte) = False
    Next Jsqte
End Sub

Private Sub Com_Qbxz_Click(Index As Integer)   '全部选中
 
    For Jsqte = Lst_Cklb(Index).ListCount - 1 To 0 Step -1
        Lst_Cklb(Index).Selected(Jsqte) = True
    Next Jsqte
       
End Sub

Private Function Yxxpd() As Boolean       '有效性判断
 
    Dim Rectemp As New ADODB.Recordset     '记录集
    Dim SqlStr As String
    Dim SQLstr1 As String
 
    Yxxpd = False
 
    '至少选中一个仓库
    If Lst_Cklb(0).SelCount = 0 Then
        Tsxx = "至少选中一个仓库!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Function
    End If
 
    '操作日期
    If Month(Xtrq) <> PGNowmon Then
        Tsxx = "操作日期不在当前会计期间(" + Trim(Str(PGKjYear)) + "." + Trim(Str(PGNowmon)) + ")之内,请重新登录!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Function
    End If
    
    '限定条件
    Query_Cond = "1=0"
    AvgQuery_Cond = "1=0"
    PlanQuery_Cond = "1=0"
    MoveQuery_Cond = "1=0"
    
    For Jsqte = 0 To Lst_Cklb(0).ListCount - 1
        If Lst_Cklb(0).Selected(Jsqte) = True Then
            Select Case Wh_Pricemode(Jsqte)
                Case "计划价法"
                    PlanQuery_Cond = PlanQuery_Cond + " or view.WhCode='" & WH_code(Jsqte) & "'"
                Case "全月平均法"
                    AvgQuery_Cond = AvgQuery_Cond + " or view.WhCode='" & WH_code(Jsqte) & "'"
                Case "移动平均法"
                    MoveQuery_Cond = MoveQuery_Cond + " or view.WhCode='" & WH_code(Jsqte) & "'"
            End Select
            
            Query_Cond = Query_Cond + " or view.WhCode='" & WH_code(Jsqte) & "'"
        
        End If
    Next Jsqte
    
    Query_Cond = "(" & Query_Cond & ")"
    AvgQuery_Cond = "(" & AvgQuery_Cond & ")"
    PlanQuery_Cond = "(" & PlanQuery_Cond & ")"
    MoveQuery_Cond = "(" & MoveQuery_Cond & ")"
   
    '操作日期大于等于单据记帐的最大日期
    SqlStr = Replace(Query_Cond, "view", "a", , , vbTextCompare)
    SqlStr = "select max(chalkdate) as maxdate from chhs_list a  where " & Trim(SqlStr) & " and startflag=0 and billcode<>'1305' and  kjyear=" & Xtyear & " and period=" & Xtmm
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    If Not Rectemp.EOF Then
        If Xtrq < Rectemp.Fields("maxdate") Then
            Tsxx = "操作日期必须>=单据记帐日期 " + Format(CStr(Rectemp.Fields("maxdate")), "yyyy-mm-dd")
            Call Xtxxts(Tsxx, 0, 4)
            Exit Function
        End If
    End If
    
    '判断期初单据是否全部记帐
    SQLstr1 = Replace(Query_Cond, "view", "Chhs_StartInputMain", , , vbTextCompare)
    SqlStr = "SELECT ChalkitupMan from Chhs_StartInputMain " & _
             " WHERE KjYear='" & PGKjYear & "' AND Period ='" & StartMon & "' AND ChalkitupMan='' AND " + SQLstr1
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    
    If Not Rectemp.EOF Then
        Tsxx = "期初单据未全部记帐!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Function
    End If
    
    '判断日常单据是否全部记帐
    SQLstr1 = Replace(Query_Cond, "view", "GY_InOutMain", , , vbTextCompare)
    SqlStr = "SELECT ChalkitupMan,BillName from GY_InOutMain  " & _
             " LEFT OUTER JOIN  GY_BillNumber ON GY_InOutMain.BillCode = GY_BillNumber.Billcode " & _
             " WHERE  KjYear='" & PGKjYear & "' AND Period ='" & PGNowmon & "' AND ChalkitupMan='' AND " + SQLstr1 & _
             " AND (GY_InOutMain.BillCode in ('1202','1203','1204','1205','1206','1212'))"
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    
    If Not Rectemp.EOF Then
        Tsxx = Trim(Rectemp.Fields("billname") & "") + "未全部记帐!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Function
    End If
 
    Yxxpd = True
    
    Set Rectemp = Nothing
 
End Function

Private Sub Com_Qd_Click()   '确定
 
    Dim Whcodestr As String      '选中仓库字符串
    Dim Msg As Integer
  
    If Not Yxxpd Then Exit Sub
 
    Tsxx = "是否进行期末处理?"
    Msg = Xtxxts(Tsxx, 1, 2)
    
    If Not Msg = 6 Then Exit Sub
 
    '期末处理
    Call EndDispose
 
End Sub

Private Sub EndDispose()        '期末处理
 
    Dim Rectemp(5) As New ADODB.Recordset
    Dim SqlStr As String
    Dim SQLstr1 As String
    Dim SQLstr2 As String
    Dim Now_period As Long           '当前月份

    Label1.Visible = True
    Label1.Refresh
 
    Now_period = PGNowmon
 
    '判断收发记录中是否暂估
    If Xtclzg Then
        If Not Djzgcl Then
            Exit Sub
        End If
    End If
    
    '调整总帐(解决暂估存货在总帐中不存在问题)
    Call Tzzg
    
    '计算全月平均单价
    CallFlag = False
    If Not PdAvgprice Then
        Call ClearZG
        '调整总帐
        Call Tzzz
        Exit Sub
    End If
  
    '计算差异率
    If Qmclcy Then       '期末是否处理差异
    
        If Not Cyljs Then
            Call ClearZG
            Call ClearPJDJ
            '调整总帐
            Call Tzzz
            Exit Sub
        End If
        
        SQLstr1 = Replace(PlanQuery_Cond, "view", "Chhs_DiffBill", 1, , vbTextCompare)
        SQLstr2 = Replace(PlanQuery_Cond, "view", "Chhs_V_DiffBill", 1, , vbTextCompare)
        SqlStr = "SELECT * FROM Chhs_DiffBill WHERE Period='" & Now_period & "' and " + SQLstr1
        Set Rectemp(0) = Cw_DataEnvi.DataConnect.Execute(SqlStr)
        
        If Not Rectemp(0).EOF Then
            
            CL_DiscrepancyChange.lbl_Tstext(0) = Str(PGKjYear) + "." + Trim(CStr(Now_period))
            CL_DiscrepancyChange.lbl_Tstext(0).Tag = Now_period
            CL_DiscrepancyChange.Query_Cond = SQLstr2
            CL_DiscrepancyChange.Show 1
            
            Tsxx = "是否确认差异结转单?"
            Yesno = Xtxxts(Tsxx, 2, 2)