企业管理

开发平台：
Visual Basic

：源码内容
							VERSION 5.00
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "tabctl32.ocx"
Begin VB.Form CL_EndDispose 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "期末处理"
   ClientHeight    =   4980
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6060
   HelpContextID   =   130406
   Icon            =   "处理_期末处理.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4980
   ScaleWidth      =   6060
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton Com_Qx 
      Cancel          =   -1  'True
      Caption         =   "取消(&C)"
      Height          =   300
      Left            =   4800
      TabIndex        =   10
      Top             =   4560
      Width           =   1120
   End
   Begin TabDlg.SSTab SSTab 
      Height          =   4035
      Left            =   90
      TabIndex        =   0
      Top             =   405
      Width           =   5865
      _ExtentX        =   10345
      _ExtentY        =   7117
      _Version        =   393216
      Style           =   1
      Tabs            =   2
      TabHeight       =   520
      TabCaption(0)   =   "未处理仓库列表"
      TabPicture(0)   =   "处理_期末处理.frx":1042
      Tab(0).ControlEnabled=   -1  'True
      Tab(0).Control(0)=   "Com_Qbfd(0)"
      Tab(0).Control(0).Enabled=   0   'False
      Tab(0).Control(1)=   "Com_Qbxz(0)"
      Tab(0).Control(1).Enabled=   0   'False
      Tab(0).Control(2)=   "Lst_Cklb(0)"
      Tab(0).Control(2).Enabled=   0   'False
      Tab(0).Control(3)=   "Com_AvgPrice"
      Tab(0).Control(3).Enabled=   0   'False
      Tab(0).Control(4)=   "Com_Qd"
      Tab(0).Control(4).Enabled=   0   'False
      Tab(0).ControlCount=   5
      TabCaption(1)   =   "已处理仓库列表"
      TabPicture(1)   =   "处理_期末处理.frx":105E
      Tab(1).ControlEnabled=   0   'False
      Tab(1).Control(0)=   "Com_Hfqmcl"
      Tab(1).Control(0).Enabled=   0   'False
      Tab(1).Control(1)=   "Com_Qbfd(1)"
      Tab(1).Control(1).Enabled=   0   'False
      Tab(1).Control(2)=   "Com_Qbxz(1)"
      Tab(1).Control(2).Enabled=   0   'False
      Tab(1).Control(3)=   "Lst_Cklb(1)"
      Tab(1).Control(3).Enabled=   0   'False
      Tab(1).ControlCount=   4
      Begin VB.CommandButton Com_Qd 
         Caption         =   "期末处理(&D)"
         Height          =   300
         Left            =   4410
         TabIndex        =   9
         Top             =   3600
         Width           =   1290
      End
      Begin VB.CommandButton Com_AvgPrice 
         Caption         =   "全月平均单价调整"
         Height          =   300
         Left            =   120
         TabIndex        =   8
         Top             =   3600
         Width           =   1695
      End
      Begin VB.ListBox Lst_Cklb 
         Height          =   2985
         Index           =   0
         Left            =   120
         Style           =   1  'Checkbox
         TabIndex        =   7
         Top             =   450
         Width           =   5580
      End
      Begin VB.CommandButton Com_Qbxz 
         Caption         =   "全选(&A)"
         Height          =   300
         Index           =   0
         Left            =   3180
         TabIndex        =   6
         Top             =   3600
         Width           =   1120
      End
      Begin VB.CommandButton Com_Qbfd 
         Caption         =   "全清(&L)"
         Height          =   300
         Index           =   0
         Left            =   1950
         TabIndex        =   5
         Top             =   3600
         Width           =   1120
      End
      Begin VB.ListBox Lst_Cklb 
         Height          =   2985
         Index           =   1
         Left            =   -74880
         Style           =   1  'Checkbox
         TabIndex        =   4
         Top             =   450
         Width           =   5580
      End
      Begin VB.CommandButton Com_Qbxz 
         Caption         =   "全选(&A)"
         Height          =   300
         Index           =   1
         Left            =   -72150
         TabIndex        =   3
         Top             =   3570
         Width           =   1120
      End
      Begin VB.CommandButton Com_Qbfd 
         Caption         =   "全清(&L)"
         Height          =   300
         Index           =   1
         Left            =   -73380
         TabIndex        =   2
         Top             =   3570
         Width           =   1120
      End
      Begin VB.CommandButton Com_Hfqmcl 
         Caption         =   "恢复期末处理(&U)"
         Height          =   300
         Left            =   -70920
         TabIndex        =   1
         Top             =   3570
         Width           =   1620
      End
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "数据正在处理中......"
      ForeColor       =   &H000000FF&
      Height          =   240
      Left            =   180
      TabIndex        =   13
      Top             =   4590
      Visible         =   0   'False
      Width           =   1800
   End
   Begin VB.Label Lbl_labText 
      AutoSize        =   -1  'True
      Caption         =   "Label1"
      Height          =   210
      Left            =   1110
      TabIndex        =   12
      Top             =   90
      Width           =   1830
   End
   Begin VB.Label Lbl_labTitle 
      AutoSize        =   -1  'True
      Caption         =   "会计期间:"
      Height          =   210
      Left            =   180
      TabIndex        =   11
      Top             =   90
      Width           =   810
   End
End
Attribute VB_Name = "CL_EndDispose"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'**************************************************************************
'*    模 块 名 称 :期末处理
'*    功 能 描 述 :
'*    程序员姓名  :杨波
'*    最后修改人  :杨波
'*    最后修改时间:2001/12/10
'*    备        注:程序中所有依实际情况自定义部分均用[>>  <<]括起
'**************************************************************************
Dim PlanQuery_Cond As String        '计划价限制条件
Dim MoveQuery_Cond As String        '移动平均限制条件
Dim AvgQuery_Cond As String         '全月平均限制条件
Dim Query_Cond As String            '全部限制条件
Dim WH_code() As String             '仓库编码
Dim Wh_Pricemode() As String        '仓库计价方法
Dim WH_codefz() As String           '已期末处理仓库编码
Dim Wh_Pricemodefz() As String      '已期末处理仓库计价方法
Dim CallFlag As Boolean             '调用标记
Dim Tsxx As String                  '提示信息
Dim Jsqte%                          '计数器
Dim RecCount As Integer             '记录数
Private Sub Com_AvgPrice_Click()    '全月平均单价调整
  
    On Error GoTo Error
 
    '有效性判断
    If Not Yxxpd Then Exit Sub
    
    '无全月平均仓库不进行计算
    If AvgQuery_Cond = "(1=0)" Then
        Tsxx = "无采用全月平均法计价的仓库!"
        Call Xtxxts(Tsxx, 0, 4)
        Label1.Visible = False
        Exit Sub
    End If
 
    Label1.Visible = True
    Label1.Refresh
 
    '系统处理暂估
    If Xtsfclzg Then
        Call Djzgcl        '暂估处理
        Call Tzzg          '调整总帐
    End If
 
 
    '计算全月平均单价
    CallFlag = True
    
    If PdAvgprice Then
        
        Label1.Visible = False
        
        If Tsxx = "采用全月平均法核算的仓库本月无出库!" Then
            Call Xtxxts(Tsxx, 0, 4)
            Exit Sub
        End If
        
        '平均单价小于等于零时，显示修改平均单价
        Edit_Flag = False
        Load CL_MonthAveragePrice
        CL_MonthAveragePrice.Query_Cond = AvgQuery_Cond
        CL_MonthAveragePrice.Show 1
    
        If Edit_Flag Then
            Tsxx = "全月平均单价计算完毕,已保存!"
        Else
            Tsxx = "全月平均单价计算完毕,未保存!"
        End If
        Call Xtxxts(Tsxx, 0, 3)
    Else
        Label1.Visible = False
        Tsxx = "无符合条件的记录!"
        Call Xtxxts(Tsxx, 0, 4)
    End If
 
    Exit Sub
 
Error:
    Tsxx = "数据发生冲突,稍候再试!"
    Call Xtxxts(Tsxx, 0, 1)
  
End Sub
Private Sub Com_Hfqmcl_Click()        '恢复期末处理
  
    Dim Rectemp As New ADODB.Recordset
    Dim RecTempFz As New ADODB.Recordset
    Dim Now_period As Long
    Dim Msg As Integer
    
    Dim SqlStr As String
  
    On Error GoTo Error
  
    '操作日期
    If Month(Xtrq) <> PGNowmon Then
        Tsxx = "操作日期不在当前会计期间(" + Trim(Str(PGKjYear)) + "." + Trim(Str(PGNowmon)) + ")之内,请重新登录!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    End If
 
    '至少选中一个仓库
    If Lst_Cklb(1).SelCount = 0 Then
        Tsxx = "至少选中一个仓库"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    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_codefz(Jsqte) & "'"
                Case "全月平均法"
                    AvgQuery_Cond = AvgQuery_Cond + " or view.WhCode='" & WH_codefz(Jsqte) & "'"
                Case "移动平均法"
                    MoveQuery_Cond = MoveQuery_Cond + " or view.WhCode='" & WH_codefz(Jsqte) & "'"
            End Select
            
            Query_Cond = Query_Cond + " or view.WhCode='" & WH_codefz(Jsqte) & "'"
        
        End If
    Next Jsqte
    
    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)
            
            If Not Yesno = 1 Then
                GoTo Error_manage
            End If
            
        End If
    End If
    
    On Error GoTo Error_manage
    
    Cw_DataEnvi.DataConnect.BeginTrans
 
 '****************全月平均法
      
    '回填出库单
    SQLstr1 = Replace(AvgQuery_Cond, "view", "Chhs_Mate", 1, , vbTextCompare)
    SqlStr = "SELECT * FROM Chhs_Mate WHERE KjYear='" & PGKjYear & "' and Period='" & Now_period & "' and  " + SQLstr1
    Set Rectemp(0) = Cw_DataEnvi.DataConnect.Execute(SqlStr)
         
    Do While Not Rectemp(0).EOF
        
        '回填收发记录出库单
        SqlStr = "SELECT InOutMainId,InOutSubId,IssueMoney FROM Chhs_V_InOut WHERE Period='" & Now_period & "' AND KjYear='" & PGKjYear & "' " & _
                 " and WhCode='" & Trim(Rectemp(0).Fields("WhCode")) & "' " & _
                 " and MNumber='" & Trim(Rectemp(0).Fields("MNumber")) & "'" & _
                 " and (BillCode='1204' or BillCode='1205' or BillCode='1206') "
        Set Rectemp(1) = Cw_DataEnvi.DataConnect.Execute(SqlStr)
        
        Do While Not Rectemp(1).EOF
            
            If SFjezt Then      '处理实发金额自填
                If Rectemp(1).Fields("issuemoney") = 0 Then
                    If Rectemp(2).State = 1 Then Rectemp(2).Close
                    SqlStr = "SELECT Price,IssueMoney,FactIssueQuan from GY_InOutSub WHERE InOutMainId='" & Rectemp(1).Fields("InOutMainId") & "' AND InOutSubId='" & Rectemp(1).Fields("InOutSubId") & "'"
                    Rectemp(2).Open SqlStr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
                    If Not Rectemp(2).EOF Then
                        Rectemp(2).Fields("Price") = Format(Val(Rectemp(0).Fields("EndPrice")), "####.0" + String(Xtdjxsws, "0"))
                        Rectemp(2).Fields("IssueMoney") = Format(Val(Rectemp(2).Fields("FactIssueQuan")) * Val(Rectemp(0).Fields("EndPrice")), "####.0" + String(Xtjexsws, "0"))
                        Rectemp(2).UpdateBatch
                    End If
                    
                    '回填明细帐出库单
                    If Rectemp(3).State = 1 Then Rectemp(3).Close
                    SqlStr = "SELECT OutPrice,OutMoney FROM Chhs_List WHERE InOutMainId='" & Rectemp(1).Fields("InOutMainId") & "' AND InOutSubId='" & Rectemp(1).Fields("InOutSubId") & "'"
                    Rectemp(3).Open SqlStr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
                    If Not Rectemp(3).EOF Then
                        Rectemp(3).Fields("OutPrice") = Format(Val(Rectemp(0).Fields("EndPrice")), "####.0" + String(Xtdjxsws, "0"))
                        Rectemp(3).Fields("OutMoney") = Format(Val(Rectemp(2).Fields("FactIssueQuan")) * Val(Rectemp(0).Fields("EndPrice")), "####.0" + String(Xtjexsws, "0"))
                        Rectemp(3).UpdateBatch
                    End If
                End If
            Else
                If Rectemp(2).State = 1 Then Rectemp(2).Close
                SqlStr = "SELECT Price,IssueMoney,FactIssueQuan from GY_InOutSub WHERE InOutMainId='" & Rectemp(1).Fields("InOutMainId") & "' AND InOutSubId='" & Rectemp(1).Fields("InOutSubId") & "'"
                Rectemp(2).Open SqlStr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
                If Not Rectemp(2).EOF Then
                    Rectemp(2).Fields("Price") = Format(Val(Rectemp(0).Fields("EndPrice")), "####.0" + String(Xtdjxsws, "0"))
                    Rectemp(2).Fields("IssueMoney") = Format(Val(Rectemp(2).Fields("FactIssueQuan")) * Val(Rectemp(0).Fields("EndPrice")), "####.0" + String(Xtjexsws, "0"))
                    Rectemp(2).UpdateBatch
                End If
                
                '回填明细帐出库单
                If Rectemp(3).State = 1 Then Rectemp(3).Close
                SqlStr = "SELECT OutPrice,OutMoney FROM Chhs_List WHERE InOutMainId='" & Rectemp(1).Fields("InOutMainId") & "' AND InOutSubId='" & Rectemp(1).Fields("InOutSubId") & "'"
                Rectemp(3).Open SqlStr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
                If Not Rectemp(3).EOF Then
                    Rectemp(3).Fields("OutPrice") = Format(Val(Rectemp(0).Fields("EndPrice")), "####.0" + String(Xtdjxsws, "0"))
                    Rectemp(3).Fields("OutMoney") = Format(Val(Rectemp(2).Fields("FactIssueQuan")) * Val(Rectemp(0).Fields("EndPrice")), "####.0" + String(Xtjexsws, "0"))
                    Rectemp(3).UpdateBatch
                End If
            End If
            Rectemp(1).MoveNext
        Loop
        Rectemp(0).MoveNext
    Loop
         
    '***********修改期末处理月份
    SQLstr1 = Replace(Query_Cond, "view", "GY_WareHouse", 1, , vbTextCompare)
    SqlStr = "UPDATE GY_WareHouse SET EndDealFlagChhs=1 WHERE " + SQLstr1
    Cw_DataEnvi.DataConnect.Execute (SqlStr)
    '调整总帐
    Call Tzzz
    
    '向物料表中填写出库成本
    Call NewOutCost
     
    Cw_DataEnvi.DataConnect.CommitTrans
     
    '刷新列表框
    Call AddWarehouseName
     
    
     
    Tsxx = "期末处理完毕!"
    Call Xtxxts(Tsxx, 0, 4)
    
    Label1.Visible = False
    
    Set Rectemp(0) = Nothing
    Set Rectemp(1) = Nothing
    Set Rectemp(2) = Nothing
    Set Rectemp(3) = Nothing
    Set Rectemp(4) = Nothing
    Set Rectemp(5) = Nothing
    
    Exit Sub
 
  
Error_manage:
    Call ClearZG
    Call ClearPJDJ
    Call ClearCYJZ
    '调整总帐
    Call Tzzz
    Label1.Visible = False
    Tsxx = "期末处理失败,请稍候再试!"
    Call Xtxxts(Tsxx, 0, 1)
  
End Sub
Private Sub ClearZG()   '处理失败，删除已生成暂估单
    
    Dim Rectemp As New ADODB.Recordset
    Dim SqlStr As String
    Dim SQLstr1 As String
    Dim Now_period As Long           '当前月份
    
    Now_period = PGNowmon
    
    SQLstr1 = Replace(Query_Cond, "view", "Chhs_List", 1, , vbTextCompare)
    SqlStr = "DELETE Chhs_List WHERE KjYear='" & PGKjYear & "' AND Period='" & Now_period & "' AND (BillCode='1304' or BillCode='1306') AND  " + SQLstr1
    Cw_DataEnvi.DataConnect.Execute (SqlStr)
    If Now_period = LastMon Then
        SqlStr = "SELECT Period FROM GY_Kjrlb WHERE Kjyear=" & PGKjYear + 1 & " AND BeginFlag=1"
        Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
        If Not Rectemp.EOF Then
            SqlStr = "DELETE Chhs_List WHERE KjYear='" & PGKjYear + 1 & "' AND Period='" & Rectemp.Fields("Period") & "' AND BillCode='1305'  AND  " + SQLstr1
            Cw_DataEnvi.DataConnect.Execute (SqlStr)
        End If
    Else
        SqlStr = "DELETE Chhs_List WHERE KjYear='" & PGKjYear & "' AND Period='" & Now_period + 1 & "' AND BillCode='1305'  AND  " + SQLstr1
        Cw_DataEnvi.DataConnect.Execute (SqlStr)
    End If
    
    Set Rectemp = Nothing
    
End Sub
Private Sub ClearPJDJ()                          '计算标记为真时，清除计算的全月平均单价
    Dim SqlStr As String
    Dim SQLstr1 As String
    Dim Now_period As Long           '当前月份
    
    Now_period = PGNowmon
    
    If Price_Flag Then
        SQLstr1 = Replace(AvgQuery_Cond, "view", "Chhs_Mate", 1, , vbTextCompare)
        SqlStr = "UPDATE Chhs_Mate SET EndPrice=0 WHERE KjYear='" & PGKjYear & "' AND Period ='" & Now_period & "' AND " + SQLstr1
        Cw_DataEnvi.DataConnect.Execute (SqlStr)
    End If
End Sub
Private Sub ClearCYJZ()
    
    Dim SqlStr As String
    Dim SQLstr1 As String
    Dim Now_period As Long           '当前月份
    
    Now_period = PGNowmon
    
    '清除差异结转单
    SQLstr1 = Replace(PlanQuery_Cond, "view", "Chhs_DiffBill", 1, , vbTextCompare)
    SqlStr = "DELETE Chhs_DiffBill WHERE KjYear='" & PGKjYear & "' and Period='" & Now_period & "' AND " + SQLstr1
    Cw_DataEnvi.DataConnect.Execute (SqlStr)
    
    '清除明细帐中的差异结转单
    SQLstr1 = Replace(PlanQuery_Cond, "view", "Chhs_List", 1, , vbTextCompare)
    SqlStr = "DELETE Chhs_List WHERE KjYear='" & PGKjYear & "' and Period='" & Now_period & "' and BillCode='1307' AND  " + SQLstr1
    Cw_DataEnvi.DataConnect.Execute (SqlStr)
End Sub
Private Function PdAvgprice() As Boolean     '全月平均单价判断
 
    Dim Rectemp As Recordset
    Dim Rec_Query As Recordset
    Dim Rec_Hz As New ADODB.Recordset
 
    Dim mMoney As Double          '金额
    Dim mQuan As Double           '数量
    Dim mOutQuan As Double        '出库数量
    Dim Avgprice As Double        '全月平均单价
 
    Dim SqlStr As String
    Dim SQLstr1 As String
    Dim Now_period As Long
 
    PdAvgprice = False
    
    Now_period = PGNowmon
    
    mQuan = 0
    mMoney = 0
    mOutQuan = 0
    
    Price_Flag = False
    
    '期初结存和本月收入的数量和金额
    If Rec_Hz.State = 1 Then Rec_Hz.Close
    SQLstr1 = Replace(AvgQuery_Cond, "view", "Chhs_Mate", , , vbTextCompare)
    
    If Not CallFlag Then
        Price_Flag = True
        SqlStr = "SELECT * FROM Chhs_Mate WHERE KjYear='" & PGKjYear & "' and Period ='" & Now_period & "' and EndPrice=0 and " + SQLstr1
    Else
        SqlStr = "SELECT * FROM Chhs_Mate WHERE KjYear='" & PGKjYear & "' and Period ='" & Now_period & "' and " + SQLstr1
    End If
    
    Rec_Hz.Open SqlStr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
    
    If Rec_Hz.EOF Then
        If Not CallFlag Then
            PdAvgprice = True
        End If
        Exit Function
    End If
    
    Jsqte = 0
    
    On Error GoTo LabelErr
    
    Cw_DataEnvi.DataConnect.BeginTrans
    
    Do While Not Rec_Hz.EOF
    
        RecCount = Rec_Hz.RecordCount
        Avgprice = 0
       
        mQuan = Val(Rec_Hz.Fields("StartQuan")) + Val(Rec_Hz.Fields("InQuan"))
        mMoney = Val(Rec_Hz.Fields("StartMoney")) + Val(Rec_Hz.Fields("InMoney")) - Val(Rec_Hz.Fields("OutMoney"))
        mOutQuan = Val(Rec_Hz.Fields("OutQuan"))
        
        If Not mOutQuan = 0 Then
        
            '平均单价计算是否包括本期暂估,不包括减掉
            If Not Xtclzg Then
                SqlStr = "SELECT InQuan,InMoney FROM Chhs_List WHERE WhCode='" & Trim(Rec_Hz.Fields("WhCode")) & "' " & _
                         " and MNumber='" & Trim(Rec_Hz.Fields("MNumber")) & "' " & _
                         " and KjYear='" & PGKjYear & "' and Period='" & Now_period & "' " & _
                         " and (BillCode='1304' or BillCode='1305'or BillCode='1306') AND StartFlag=0"
                Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(SqlStr)
               
                Do While Not Rec_Query.EOF
                    mQuan = mQuan - (Val(Rec_Query.Fields("InQuan")))
                    mMoney = mMoney - Val(Rec_Query.Fields("InMoney"))
                    Rec_Query.MoveNext
                Loop
            End If
              
            '实发金额自填 数量、金额
            If SFjezt Then
                SqlStr = "SELECT OutQuan,OutMoney FROM Chhs_List WHERE WhCode='" & Trim(Rec_Hz.Fields("WhCode")) & "'" & _
                        " and MNumber='" & Trim(Rec_Hz.Fields("MNumber")) & "' and Period='" & Now_period & "'" & _
                        " and KjYear='" & PGKjYear & "' and  SfjeztFlag=1 "
                Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                
                Do While Not Rectemp.EOF
                    mQuan = mQuan - Val(Rectemp.Fields("OutQuan"))
                    Rectemp.MoveNext
                Loop
            End If
            
            '计算平均单价
            If mQuan <> 0 Then
                Avgprice = Format((mMoney) / (mQuan), "####." + String(Xtdjxsws, "0"))
                
                '期末处理时退出计算过程
                If Avgprice <= 0 And Not CallFlag Then
                    GoTo LabelErr
                    Exit Function
                End If
            Else
                
                '期末处理数量等于零时退出计算过程
                If Not CallFlag Then
                    GoTo LabelErr
                    Exit Function
                End If
              
            End If
             
            '回填单价
            Cw_DataEnvi.DataConnect.Execute ("Update Chhs_Mate set EndPrice='" & Avgprice & "' where MateId='" & Rec_Hz.Fields("MateId") & "'")
        Else
            Jsqte = Jsqte + 1
        End If
        Rec_Hz.MoveNext
           
    Loop
      
    Cw_DataEnvi.DataConnect.CommitTrans
    If Jsqte = RecCount Then
        Tsxx = "采用全月平均法核算的仓库本月无出库!"
    End If
    PdAvgprice = True
    Set Rectemp = Nothing
    Set Rec_Query = Nothing
    Set Rec_Hz = Nothing
    
    Exit Function
    
LabelErr:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Label1.Visible = False
    PdAvgprice = False
    Tsxx = "全月平均单价小于等于零时,不允许期末处理!"
    Call Xtxxts(Tsxx, 0, 1)
End Function
Private Sub Tzzz()   '调整总帐
  
    Dim RecQc As New ADODB.Recordset            '期初记录
    Dim RecSummx As New ADODB.Recordset         '汇总明细帐
    Dim Reczz As New ADODB.Recordset            '总帐
    Dim RecZzfz As New ADODB.Recordset          '总帐
    Dim Now_period As Long
    Dim SqlStr As String
    Now_period = PGNowmon
  
    '打开总帐表
    If Reczz.State = 1 Then Reczz.Close
    Reczz.Open "SELECT * FROM Chhs_Mate ", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
    
    '清除总帐本月发生数据
    SqlStr = Replace(Query_Cond, "view", "Chhs_Mate", , , vbTextCompare)
    Cw_DataEnvi.DataConnect.Execute ("DELETE Chhs_Mate WHERE KjYear='" & PGKjYear & "' and Period='" & Now_period & "' AND  StartQuan=0 AND " + SqlStr)
    Cw_DataEnvi.DataConnect.Execute ("UPDATE Chhs_Mate SET InQuan=0,Inprice=0,Inmoney=0 ," & _
                                     "OutQuan=0 ,OutPrice=0, OutMoney=0 ,JfDiff=0,Dfdiff=0 ,EndDiff=0,EndQuan=0," & _
                                     "EndPrice=0,EndMoney=0 WHERE KjYear='" & PGKjYear & "' and Period='" & Now_period & "' AND " + SqlStr)
     
    '汇总明细帐
    SqlStr = Replace(Query_Cond, "view", "Chhs_List", , , vbTextCompare)
    SqlStr = "SELECT WhCode,MNumber,KjYear,Period, SUM(InQuan) AS sum_recquan,SUM(InMoney) AS sum_recmoney, " & _
             "SUM(OutQuan) AS sum_outquan, SUM(OutMoney) AS sum_outmoney," & _
             "SUM(JfDiff) as sumjf_diff,SUM(DfDiff) AS sumdf_diff From Chhs_List " & _
             "WHERE Chhs_List.startflag=0 AND KjYear='" & PGKjYear & "' and Period='" & Now_period & "' and " + SqlStr & _
             " GROUP BY WhCode,MNumber,KjYear,Period "
    Set RecSummx = Cw_DataEnvi.DataConnect.Execute(SqlStr)
     
    Do While Not RecSummx.EOF
     
        '对比总帐中是否存在相同的仓库+物料
        SqlStr = "SELECT * FROM Chhs_Mate WHERE KjYear='" & PGKjYear & "' and Period='" & Now_period & "' " & _
                 "AND WhCode='" & Trim(RecSummx.Fields("WhCode")) & "' " & _
                 "AND MNumber='" & Trim(RecSummx.Fields("MNumber")) & "'"
        
        If RecQc.State = 1 Then RecQc.Close
        RecQc.Open SqlStr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
        
        If Not RecQc.EOF Then
        
            '加入发生额
            If Not IsNull(RecSummx.Fields("sum_recquan")) Then
               RecQc.Fields("InQuan") = Format(Val(RecSummx.Fields("sum_recquan")), "#####." + String(Xtslxsws, "0"))
            End If
            If Not Val(RecSummx.Fields("sum_recquan")) = 0 Then
               RecQc.Fields("InPrice") = Format(Val(RecSummx.Fields("sum_recmoney")) / Val(RecSummx.Fields("sum_recquan")), "#####." + String(Xtdjxsws, "0"))
            End If
            If Not IsNull(RecSummx.Fields("sum_recmoney")) Then
               RecQc.Fields("InMoney") = Format(Val(RecSummx.Fields("sum_recmoney")), "#####." + String(Xtjexsws, "0"))
            End If
            If Not IsNull(RecSummx.Fields("sum_outquan")) Then
               RecQc.Fields("OutQuan") = Format(Val(RecSummx.Fields("sum_outquan")), "#####." + String(Xtslxsws, "0"))
            End If
            If Not Val(RecSummx.Fields("sum_outquan")) = 0 Then
               RecQc.Fields("OutPrice") = Format(Val(RecSummx.Fields("sum_outmoney")) / Val(RecSummx.Fields("sum_outquan")), "#####." + String(Xtdjxsws, "0"))
            End If
            If Not IsNull(RecSummx.Fields("sum_outmoney")) Then
               RecQc.Fields("OutMoney") = Format(Val(RecSummx.Fields("sum_outmoney")), "#####." + String(Xtjexsws, "0"))
            End If
            If Not IsNull(RecSummx.Fields("sumjf_diff")) Then
               RecQc.Fields("JfDiff") = Format(Val(RecSummx.Fields("sumjf_diff")), "#####." + String(Xtjexsws, "0"))
            End If
            If Not IsNull(RecSummx.Fields("sumdf_diff")) Then
               RecQc.Fields("Dfdiff") = Format(Val(RecSummx.Fields("sumdf_diff")), "#####." + String(Xtjexsws, "0"))
            End If
            RecQc.UpdateBatch
        
        Else
            
            '添加新记录
            Reczz.AddNew
            Reczz.Fields("WhCode") = Trim(RecSummx.Fields("WhCode"))
            Reczz.Fields("MNumber") = Trim(RecSummx.Fields("MNumber"))
            Reczz.Fields("KjYear") = PGKjYear
            Reczz.Fields("Period") = Val(RecSummx.Fields("Period"))
            
            Reczz.Fields("StartQuan") = 0
            Reczz.Fields("StartPrice") = 0
            Reczz.Fields("StartMoney") = 0
            
            Reczz.Fields("InQuan") = Format(Val(RecSummx.Fields("sum_recquan")), "#####." + String(Xtslxsws, "0"))
            If Not Val(RecSummx.Fields("sum_recquan")) = 0 Then
               Reczz.Fields("InPrice") = Format(Val(RecSummx.Fields("sum_recmoney")) / Val(RecSummx.Fields("sum_recquan")), "#####." + String(Xtdjxsws, "0"))
            End If
            Reczz.Fields("InMoney") = Format(Val(RecSummx.Fields("sum_recmoney")), "#####." + String(Xtjexsws, "0"))
            
            Reczz.Fields("OutQuan") = Format(Val(RecSummx.Fields("sum_outquan")), "#####." + String(Xtslxsws, "0"))
            If Not Val(RecSummx.Fields("sum_outquan")) = 0 Then
               Reczz.Fields("OutPrice") = Format(Val(RecSummx.Fields("sum_outmoney")) / Val(RecSummx.Fields("sum_outquan")), "#####." + String(Xtdjxsws, "0"))
            End If
            Reczz.Fields("OutMoney") = Format(Val(RecSummx.Fields("sum_outmoney")), "#####." + String(Xtjexsws, "0"))
            
            If Not IsNull(RecSummx.Fields("sumjf_diff")) Then
               Reczz.Fields("JfDiff") = Format(Val(RecSummx.Fields("sumjf_diff")), "#####." + String(Xtjexsws, "0"))
            End If
            If Not IsNull(RecSummx.Fields("sumdf_diff")) Then
               Reczz.Fields("DfDiff") = Format(Val(RecSummx.Fields("sumdf_diff")), "#####." + String(Xtjexsws, "0"))
            End If
            
            Reczz.UpdateBatch
        End If
        
        RecSummx.MoveNext
     Loop
End Sub
Private Sub Tzzg()  '暂估单处理完后，调整总帐
    Dim RecQc As New ADODB.Recordset            '期初记录
    Dim RecSummx As New ADODB.Recordset         '汇总明细帐
    Dim Reczz As New ADODB.Recordset            '总帐
    Dim RecZzfz As New ADODB.Recordset          '总帐
    Dim Now_period As Long
    Dim SqlStr As String
    Now_period = PGNowmon
  
    '打开总帐表
    If Reczz.State = 1 Then Reczz.Close
    Reczz.Open "SELECT * FROM Chhs_Mate ", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
    '汇总明细帐
    SqlStr = Replace(Query_Cond, "view", "Chhs_List", , , vbTextCompare)
    SqlStr = "SELECT WhCode,MNumber,KjYear,Period, SUM(InQuan) AS sum_recquan,SUM(InMoney) AS sum_recmoney, " & _
             "SUM(OutQuan) AS sum_outquan, SUM(OutMoney) AS sum_outmoney," & _
             "SUM(JfDiff) as sumjf_diff,SUM(DfDiff) AS sumdf_diff From Chhs_List " & _
             "WHERE BillCode='1304' AND StartFlag<>1 AND KjYear='" & PGKjYear & "' and Period='" & Now_period & "' and " + SqlStr & _
             " GROUP BY WhCode,MNumber,KjYear,Period "
    Set RecSummx = Cw_DataEnvi.DataConnect.Execute(SqlStr)
     
    Do While Not RecSummx.EOF
     
        '对比总帐中是否存在相同的仓库+物料
        SqlStr = "SELECT * FROM Chhs_Mate WHERE KjYear='" & PGKjYear & "' and Period='" & Now_period & "' " & _
                 "AND WhCode='" & Trim(RecSummx.Fields("WhCode")) & "' " & _
                 "AND MNumber='" & Trim(RecSummx.Fields("MNumber")) & "'"
        
        If RecQc.State = 1 Then RecQc.Close
        RecQc.Open SqlStr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
        
        If Not RecQc.EOF Then
        
            '加入发生额
            If Not IsNull(RecSummx.Fields("sum_recquan")) Then
               RecQc.Fields("InQuan") = Format(Val(RecSummx.Fields("sum_recquan")) + Val(RecQc.Fields("InQuan")), "#####." + String(Xtslxsws, "0"))
            End If
            If Not IsNull(RecSummx.Fields("sum_recmoney")) Then
               RecQc.Fields("InMoney") = Format(Val(RecSummx.Fields("sum_recmoney")) + Val(RecQc.Fields("InMoney")), "#####." + String(Xtjexsws, "0"))
            End If
            If Not Val(RecQc.Fields("InQuan")) = 0 Then
               RecQc.Fields("InPrice") = Format(Val(RecQc.Fields("InMoney")) / Val(RecQc.Fields("InQuan")), "#####." + String(Xtdjxsws, "0"))
            End If
            If Not IsNull(RecSummx.Fields("sumjf_diff")) Then
               RecQc.Fields("JfDiff") = Format(Val(RecSummx.Fields("sumjf_diff") + RecQc.Fields("JfDiff")), "#####." + String(Xtjexsws, "0"))
            End If
            If Not IsNull(RecSummx.Fields("sumdf_diff")) Then
               RecQc.Fields("Dfdiff") = Format(Val(RecSummx.Fields("sumdf_diff") + RecQc.Fields("Dfdiff")), "#####." + String(Xtjexsws, "0"))
            End If
            RecQc.UpdateBatch
        
        Else
            
            '添加新记录
            Reczz.AddNew
            Reczz.Fields("WhCode") = Trim(RecSummx.Fields("WhCode"))
            Reczz.Fields("MNumber") = Trim(RecSummx.Fields("MNumber"))
            Reczz.Fields("KjYear") = PGKjYear
            Reczz.Fields("Period") = Val(RecSummx.Fields("Period"))
            
            Reczz.Fields("StartQuan") = 0
            Reczz.Fields("StartPrice") = 0
            Reczz.Fields("StartMoney") = 0
            
            Reczz.Fields("InQuan") = Format(Val(RecSummx.Fields("sum_recquan")), "#####." + String(Xtslxsws, "0"))
            If Not Val(RecSummx.Fields("sum_recquan")) = 0 Then
               Reczz.Fields("InPrice") = Format(Val(RecSummx.Fields("sum_recmoney")) / Val(RecSummx.Fields("sum_recquan")), "#####." + String(Xtdjxsws, "0"))
            End If
            Reczz.Fields("InMoney") = Format(Val(RecSummx.Fields("sum_recmoney")), "#####." + String(Xtjexsws, "0"))
            If Not IsNull(RecSummx.Fields("sumjf_diff")) Then
               Reczz.Fields("JfDiff") = Format(Val(RecSummx.Fields("sumjf_diff")), "#####." + String(Xtjexsws, "0"))
            End If
            If Not IsNull(RecSummx.Fields("sumdf_diff")) Then
               Reczz.Fields("DfDiff") = Format(Val(RecSummx.Fields("sumdf_diff")), "#####." + String(Xtjexsws, "0"))
            End If
            
            Reczz.UpdateBatch
        End If
        
        RecSummx.MoveNext
     Loop
End Sub
Private Function Djzgcl() As Boolean          '单据暂估处理
 
    Dim Rec As New ADODB.Recordset
    Dim Rectemp As New ADODB.Recordset
    Dim RecTempFz As New ADODB.Recordset
    Dim Rec_Mxz As New ADODB.Recordset
 
    Dim SqlStr As String
    Dim SQLstr1 As String
    Dim Now_period As Long
 
    Dim Glgjxztj As String                            '暂估条件
    Dim Glgjxztj1 As String
    
    Now_period = PGNowmon
    
    Djzgcl = False
    
     
    '暂估条件限制
    Set Rec = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM Chhs_Evalu ORDER BY EvaluId")
    If Rec.EOF Then
        Djzgcl = True
        Exit Function
    End If
    
    Do While Not Rec.EOF
    
        If Trim(Rec.Fields("WhCode") & "") <> "" Then
            If Glgjxztj1 <> "" Then
                Glgjxztj1 = Glgjxztj1 + " and Chhs_V_StartEval.WhCode ='" & Trim(Rec.Fields("WhCode")) & "'"
            Else
                Glgjxztj1 = " Chhs_V_StartEval.WhCode ='" & Trim(Rec.Fields("WhCode")) & "'"
            End If
        End If
       
        If Trim(Rec.Fields("MSort") & "") <> "" Then
            If Glgjxztj1 <> "" Then
                Glgjxztj1 = Glgjxztj1 + " and Chhs_V_StartEval.InvSortCode like '" & Trim(Rec.Fields("MSort")) & "%'"
            Else
                Glgjxztj1 = " Chhs_V_StartEval.InvSortCode like '" & Trim(Rec.Fields("MSort")) & "%'"
            End If
        End If
       
        If Trim(Rec.Fields("MNumber") & "") <> "" Then
            If Glgjxztj1 <> "" Then
                Glgjxztj1 = Glgjxztj1 + " and  Chhs_V_StartEval.MNumber ='" & Trim(Rec.Fields("MNumber")) & "'"
            Else
                Glgjxztj1 = " Chhs_V_StartEval.MNumber ='" & Trim(Rec.Fields("MNumber")) & "'"
            End If
        End If
    
        Rec.MoveNext
        
        If Glgjxztj1 <> "" Then
            If Glgjxztj <> "" Then
                Glgjxztj = Glgjxztj + " OR " + "(" & Glgjxztj1 & ")"
            Else
                Glgjxztj = "(" & Glgjxztj1 & ")"
            End If
        End If
        
    Loop
    
    '明细帐
    If Rec_Mxz.State = 1 Then Rec_Mxz.Close
    Rec_Mxz.Open "SELECT * FROM Chhs_List where 1=0", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
    
    On Error GoTo LabelErr
    
    Cw_DataEnvi.DataConnect.BeginTrans
    
    '判断收发记录中是否存在暂估单
    SQLstr1 = Replace(Query_Cond, "view", "Chhs_V_StartEval", 1, , vbTextCompare)
    SqlStr = "SELECT * FROM Chhs_V_StartEval WHERE (BillCode='1201' or BillCode='1211') and (BalanceDate is null or BalanceDate='') " & _
             " and (Kjyear <" & PGKjYear & " or (Kjyear=" & PGKjYear & "  and Period<=" & PGNowmon & ")) AND EMoney<>0 and " + SQLstr1 + " AND " & Glgjxztj & " "
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    
    Do While Not Rectemp.EOF
       
        '查找明细帐中对应的记录（蓝字暂估单）
        SqlStr = "SELECT * FROM Chhs_List WHERE startflag=0 and InoutMainId='" & Rectemp.Fields("InoutMainId") & "' and InoutSubId='" & Rectemp.Fields("InoutSubId") & "' " & _
                 "and BillCode='1304' and Period='" & Now_period & "' AND KjYear='" & PGKjYear & "'"
        Set RecTempFz = Cw_DataEnvi.DataConnect.Execute(SqlStr)
        
        If RecTempFz.EOF Then
                
            '1-蓝字暂估单记明细帐
            Rec_Mxz.AddNew
            Rec_Mxz.Fields("InoutFlag") = Trim(Rectemp.Fields("InoutFlag"))
            If Trim(Rectemp.Fields("OperType") & "") <> "" Then
               Rec_Mxz.Fields("OperType") = Trim(Rectemp.Fields("OperType"))
            End If
            If Trim(Rectemp.Fields("OperbillNum") & "") <> "" Then
               Rec_Mxz.Fields("OperbillNum") = Trim(Rectemp.Fields("OperbillNum"))
            End If
            If Trim(Rectemp.Fields("BillNum") & "") <> "" Then
               Rec_Mxz.Fields("BillNum") = Trim(Rectemp.Fields("BillNum"))
            End If
            If Trim(Rectemp.Fields("InoutMainId") & "") Then
               Rec_Mxz.Fields("InoutMainId") = Trim(Rectemp.Fields("InoutMainId"))
            End If
            If Trim(Rectemp.Fields("InoutSubId") & "") Then
               Rec_Mxz.Fields("InoutSubId") = Trim(Rectemp.Fields("InoutSubId"))
            End If
            Rec_Mxz.Fields("BillDate") = Xtrq
            Rec_Mxz.Fields("ChalkDate") = Xtrq
            Rec_Mxz.Fields("KjYear") = Xtyear
            Rec_Mxz.Fields("Period") = Now_period
            Rec_Mxz.Fields("BillCode") = "1304"
            If Trim(Rectemp.Fields("PurTypeCode") & "") <> "" Then
                Rec_Mxz.Fields("PurTypeCode") = Trim(Rectemp.Fields("PurTypeCode"))
            End If
            If Trim(Rectemp.Fields("WhCode") & "") <> "" Then
                Rec_Mxz.Fields("WhCode") = Trim(Rectemp.Fields("WhCode"))
            End If
            If Trim(Rectemp.Fields("DeptCode") & "") <> "" Then
                Rec_Mxz.Fields("DeptCode") = Trim(Rectemp.Fields("DeptCode"))
            End If
            If Trim(Rectemp.Fields("ReceiptNum") & "") <> "" Then
                Rec_Mxz.Fields("ReceiptNum") = Trim(Rectemp.Fields("ReceiptNum"))
            End If
            If Trim(Rectemp.Fields("PersonCode") & "") <> "" Then
                Rec_Mxz.Fields("Personcode") = Trim(Rectemp.Fields("PersonCode"))
            End If
            If Trim(Rectemp.Fields("InoutClassCode") & "") <> "" Then
                Rec_Mxz.Fields("InoutClassCode") = Trim(Rectemp.Fields("InoutClassCode"))
            End If
            If Trim(Rectemp.Fields("SupplierCode") & "") <> "" Then
                Rec_Mxz.Fields("SupplierCode") = Trim(Rectemp.Fields("SupplierCode"))
            End If
            If Trim(Rectemp.Fields("MNumber") & "") <> "" Then
                Rec_Mxz.Fields("MNumber") = Trim(Rectemp.Fields("MNumber"))
            End If
            Rec_Mxz.Fields("InQuan") = Val(Rectemp.Fields("FactReceiptQuan"))
             
            '以计划价法核算按计划价入库 ，以实际价核算的按实际价入库
            If Trim(Rectemp.Fields("PriceMode")) = "计划价法" And Qmclcy Then
                Rec_Mxz.Fields("InPrice") = Val(Rectemp.Fields("PlanPrice"))
                Rec_Mxz.Fields("Inmoney") = Val(Rectemp.Fields("PlanMoney"))
                
                If Val(Rectemp.Fields("EMoney")) - Val(Rectemp.Fields("PlanMoney")) > 0 Then
                   Rec_Mxz.Fields("JfDiff") = Val(Rectemp.Fields("Emoney")) - Val(Rectemp.Fields("PlanMoney"))
                Else
                   Rec_Mxz.Fields("DfDiff") = Val(Rectemp.Fields("PlanMoney")) - Val(Rectemp.Fields("Emoney"))
                End If
            Else
                Rec_Mxz.Fields("InPrice") = Val(Rectemp.Fields("Price"))
                Rec_Mxz.Fields("InMoney") = Val(Rectemp.Fields("EMoney"))
            End If
            
            If Trim(Rectemp.Fields("Maker") & "") <> "" Then
                Rec_Mxz.Fields("Maker") = Trim(Rectemp.Fields("Maker"))
            End If
            Rec_Mxz.Fields("checker") = Xtczy
            Rec_Mxz.Fields("ChalkitupMan") = Xtczy
            If Trim(Rectemp.Fields("Remark") & "") <> "" Then
                Rec_Mxz.Fields("Remark") = Trim(Rectemp.Fields("Remark"))
            End If
            
            '填写物料科目和差异科目
            Call MaccCode(Trim(Rectemp.Fields("WhCode") & ""), Trim(Rectemp.Fields("MNumber") & ""), Trim(Rectemp.Fields("InvSortcode") & ""))
            Rec_Mxz.Fields("MateAcct") = Xtfhcs
            If Trim(Rectemp.Fields("PriceMode")) = "计划价法" And Qmclcy And Val(Rectemp.Fields("EMoney")) - Val(Rectemp.Fields("PlanMoney")) <> 0 Then
                Rec_Mxz.Fields("DiffAcct") = Xtfhcsfz
            End If
                
            ' 对方科目
            Call DfaccCode(Trim(Rectemp.Fields("InoutClassCode") & ""), Trim(Rectemp.Fields("DeptCode") & ""), Trim(Rectemp.Fields("InvSortcode") & ""), Trim(Rectemp.Fields("MNumber")) & "")
            Rec_Mxz.Fields("DfAcct") = Xtfhcs
            
            Rec_Mxz.UpdateBatch
            
            '收发记录中对应的相应单据，填写记帐标志
            SqlStr = "UPDATE GY_InOutMain SET ChalkitupMan='" & Xtczy & "' WHERE BiLLCode='1201' AND InOutMainId='" & Trim(Rectemp.Fields("InoutMainId")) & "'"
            Cw_DataEnvi.DataConnect.Execute (SqlStr)
            
            '2-生成下月红字回冲单
            Rec_Mxz.AddNew
            Rec_Mxz.Fields("InoutFlag") = Trim(Rectemp.Fields("InoutFlag"))
            If Trim(Rectemp.Fields("OperType") & "") <> "" Then
                Rec_Mxz.Fields("OperType") = Trim(Rectemp.Fields("OperType"))
            End If
            If Trim(Rectemp.Fields("OperBillNum") & "") <> "" Then
               Rec_Mxz.Fields("OperBillNum") = Trim(Rectemp.Fields("OperBillNum"))
            End If
            If Trim(Rectemp.Fields("BillNum") & "") <> "" Then
               Rec_Mxz.Fields("BillNum") = Trim(Rectemp.Fields("BillNum"))
            End If
            If Trim(Rectemp.Fields("InoutMainId") & "") <> "" Then
               Rec_Mxz.Fields("InoutMainId") = Trim(Rectemp.Fields("InoutMainId"))
            End If
            If Trim(Rectemp.Fields("InoutSubId") & "") <> "" Then
               Rec_Mxz.Fields("InoutSubId") = Trim(Rectemp.Fields("InoutSubId"))
            End If
            
            '年末处理
            If Now_period <> LastMon Then
                Set Rec = Cw_DataEnvi.DataConnect.Execute("SELECT qsrq FROM GY_Kjrlb WHERE Kjyear=" & Xtyear & " and Period=" & Now_period + 1 & "")
                If Not Rec.EOF Then
                   Rec_Mxz.Fields("BillDate") = Trim(Rec.Fields("qsrq"))
                End If
                Rec_Mxz.Fields("ChalkDate") = Rec_Mxz.Fields("BillDate")
                Rec_Mxz.Fields("KjYear") = Xtyear
                Rec_Mxz.Fields("Period") = Now_period + 1
            Else
                Set Rec = Cw_DataEnvi.DataConnect.Execute("SELECT qsrq FROM GY_Kjrlb WHERE Kjyear=" & Xtyear + 1 & " and Period='1'")
                If Not Rec.EOF Then
                   Rec_Mxz.Fields("BillDate") = Trim(Rec.Fields("qsrq"))
                End If
                Rec_Mxz.Fields("ChalkDate") = Rec_Mxz.Fields("BillDate")
                Rec_Mxz.Fields("KjYear") = Xtyear + 1
                Rec_Mxz.Fields("Period") = 1
            End If
            
            '填写物料科目和差异科目
            Xtfhcs = ""
            Xtfhcsfz = ""
            Call MaccCode(Trim(Rectemp.Fields("WhCode") & ""), Trim(Rectemp.Fields("MNumber") & ""), Trim(Rectemp.Fields("InvSortcode")) & "")
            Rec_Mxz.Fields("MateAcct") = Xtfhcs
            
            If Trim(Rectemp.Fields("PriceMode")) = "计划价法" And Qmclcy And Val(Rectemp.Fields("EMoney")) - Val(Rectemp.Fields("PlanMoney")) <> 0 Then
                Rec_Mxz.Fields("DiffAcct") = Xtfhcsfz
            End If
            
            ' 对方科目
            Xtfhcs = ""
            Xtfhcsfz = ""
            Call DfaccCode(Trim(Rectemp.Fields("InoutClassCode") & ""), Trim(Rectemp.Fields("DeptCode") & ""), Trim(Rectemp.Fields("InvSortcode") & ""), Trim(Rectemp.Fields("MNumber")) & "")
            Rec_Mxz.Fields("DfAcct") = Xtfhcs
            
            Rec_Mxz.Fields("BillCode") = "1305"
            
            If Trim(Rectemp.Fields("PurTypeCode") & "") <> "" Then
                Rec_Mxz.Fields("PurTypeCode") = Trim(Rectemp.Fields("PurTypeCode"))
            End If
            If Trim(Rectemp.Fields("WhCode") & "") <> "" Then
                Rec_Mxz.Fields("WhCode") = Trim(Rectemp.Fields("WhCode"))
            End If
            If Trim(Rectemp.Fields("DeptCode") & "") <> "" Then
                Rec_Mxz.Fields("DeptCode") = Trim(Rectemp.Fields("DeptCode"))
            End If
            If Trim(Rectemp.Fields("ReceiptNum") & "") <> "" Then
                Rec_Mxz.Fields("ReceiptNum") = Trim(Rectemp.Fields("ReceiptNum"))
            End If
            If Trim(Rectemp.Fields("PersonCode") & "") <> "" Then
                Rec_Mxz.Fields("PersonCode") = Trim(Rectemp.Fields("PersonCode"))
            End If
            If Trim(Rectemp.Fields("InoutClassCode") & "") <> "" Then
                Rec_Mxz.Fields("InoutClassCode") = Trim(Rectemp.Fields("InoutClassCode"))
            End If
            If Trim(Rectemp.Fields("SupplierCode") & "") <> "" Then
                Rec_Mxz.Fields("SupplierCode") = Trim(Rectemp.Fields("SupplierCode"))
            End If
            If Trim(Rectemp.Fields("MNumber") & "") <> "" Then
                Rec_Mxz.Fields("MNumber") = Trim(Rectemp.Fields("MNumber"))
            End If
            Rec_Mxz.Fields("InQuan") = 0 - Val(Rectemp.Fields("FactReceiptQuan"))
            
            '以计划价法核算按计划价入库 ，以实际价核算的按实际价入库
            If Trim(Rectemp.Fields("PriceMode")) = "计划价法" And Qmclcy Then
                Rec_Mxz.Fields("InPrice") = Val(Rectemp.Fields("PlanPrice"))
                Rec_Mxz.Fields("Inmoney") = 0 - Val(Rectemp.Fields("PlanMoney"))
        
                If Val(Rectemp.Fields("EMoney")) - Val(Rectemp.Fields("PlanMoney")) > 0 Then
                    Rec_Mxz.Fields("dfDiff") = Val(Rectemp.Fields("Emoney")) - Val(Rectemp.Fields("PlanMoney"))
                Else
                    Rec_Mxz.Fields("jfDiff") = Val(Rectemp.Fields("PlanMoney")) - Val(Rectemp.Fields("Emoney"))
                End If
            Else
                Rec_Mxz.Fields("InPrice") = Val(Rectemp.Fields("Price"))
                Rec_Mxz.Fields("InMoney") = 0 - Val(Rectemp.Fields("EMoney"))
            End If
            
            If Trim(Rectemp.Fields("Maker") & "") <> "" Then
                Rec_Mxz.Fields("Maker") = Trim(Rectemp.Fields("Maker"))
            End If
            Rec_Mxz.Fields("checker") = Xtczy
            
            Rec_Mxz.Fields("ChalkitupMan") = Xtczy
            
            If Trim(Rectemp.Fields("Remark") & "") <> "" Then
                Rec_Mxz.Fields("Remark") = Trim(Rectemp.Fields("Remark"))
            End If
            
            Rec_Mxz.UpdateBatch
            
        End If
       
        Rectemp.MoveNext
    Loop
    
    Cw_DataEnvi.DataConnect.CommitTrans
    Djzgcl = True
 
LabelExit:
    Set Rec = Nothing
    Set Rectemp = Nothing
    Set RecTempFz = Nothing
    Set Rec_Mxz = Nothing
    
    Exit Function
    
LabelErr:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Label1.Visible = False
    Djzgcl = False
    Tsxx = "在暂估处理过程中出现未知错误，期末处理失败!"
    Call Xtxxts(Tsxx, 0, 1)
    
End Function
Private Sub Com_Qx_Click()   '取消
   Unload Me
   
End Sub
Private Sub Form_Load()
    '添加仓库
    Call AddWarehouseName
 
    Lbl_labText = CStr(Xtyear) + "." + CStr(PGNowmon)
    SSTab.Tab = 0
      
End Sub
Private Sub AddWarehouseName()        '填充列表框
 
    Dim Rectemp As New ADODB.Recordset
    Dim SqlStr As String
 
    Lst_Cklb(0).Clear
    Lst_Cklb(1).Clear
    
    SqlStr = "SELECT GY_WareHouse.*, GY_whlimit.czybm " & _
             " FROM GY_WareHouse LEFT OUTER JOIN  GY_whlimit ON GY_WareHouse.WhCode = GY_whlimit.WhCode " & _
             " WHERE czybm='" & Xtczybm & "' AND ChhsUseFlag=1 ORDER BY GY_WareHouse.WhCode"
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    
    If Not Rectemp.EOF Then
 
        '限定仓库个数
        ReDim WH_code(Rectemp.RecordCount)
        ReDim Wh_Pricemode(Rectemp.RecordCount)
    
        ReDim WH_codefz(Rectemp.RecordCount)
        ReDim Wh_Pricemodefz(Rectemp.RecordCount)
    
        '添加仓库列表
        For Jsqte = 0 To Rectemp.RecordCount - 1
            If Rectemp.Fields("EndDealFlagChhs") Then
                Lst_Cklb(1).AddItem Trim(Rectemp.Fields("WhName")) + "（" + Trim(Rectemp.Fields("WhCode")) + "）" + " ---- " + Trim(Rectemp.Fields("PriceMode"))
                WH_codefz(Lst_Cklb(1).NewIndex) = Trim(Rectemp.Fields("WhCode"))
                Wh_Pricemodefz(Lst_Cklb(1).NewIndex) = Trim(Rectemp.Fields("PriceMode"))
                Lst_Cklb(1).Selected(Lst_Cklb(1).NewIndex) = True
            Else
                Lst_Cklb(0).AddItem Trim(Rectemp.Fields("WhName")) + "（" + Trim(Rectemp.Fields("WhCode")) + "）" + " ---- " + Trim(Rectemp.Fields("PriceMode"))
                WH_code(Lst_Cklb(0).NewIndex) = Trim(Rectemp.Fields("WhCode"))
                Wh_Pricemode(Lst_Cklb(0).NewIndex) = Trim(Rectemp.Fields("PriceMode"))
                Lst_Cklb(0).Selected(Lst_Cklb(0).NewIndex) = True
            End If
            Rectemp.MoveNext
        Next Jsqte
    
    End If
    
    Set Rectemp = Nothing
End Sub
Private Function Cyljs() As Boolean                                    '差异率计算
    Dim Rectemp As New ADODB.Recordset
    Dim Rec_Query As New ADODB.Recordset               '查询动态集
    Dim Rec_Queryfz As New ADODB.Recordset
    Dim Recmx As New ADODB.Recordset
 
    Dim Qcmoney As Double                              '期初余额
    Dim Qcdiff As Double                               '期初差异
    Dim Byrecmoney As Double                           '本月入库金额
    Dim Bydiff As Double                               '本月差异
    Dim Byoutmoney As Double                           '本月出库调整金额
    Dim Diff_lv As Double                              '差异率
    Dim SqlStr As String
    Dim Now_period As Long
    Dim BillID As Long
    Dim Sort As String
    
    '以下为用户自定义部分[
    Now_period = PGNowmon
    
    Cyljs = False
 
    '差异结转单
    If Rectemp.State = 1 Then Rectemp.Close
    Rectemp.Open "SELECT * FROM Chhs_DiffBill", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
    
    On Error GoTo LabelErr
    
    Cw_DataEnvi.DataConnect.BeginTrans
    
    
    '月初差异 月初金额 本月收入差异   本月收入金额
    SqlStr = Replace(PlanQuery_Cond, "view", "Chhs_Mate", 1, , vbTextCompare)
    SqlStr = "SELECT WhCode,MNumber,StartDiff,StartMoney,JfDiff,DfDiff,Inmoney,OutQuan,OutMoney FROM Chhs_Mate WHERE KjYear='" & PGKjYear & "' and Period='" & Now_period & "' and " + SqlStr + " order by MNumber"
    Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    
    Do While Not Rec_Query.EOF
    
        Qcdiff = Rec_Query.Fields("StartDiff")
        Qcmoney = Rec_Query.Fields("StartMoney")
        Bydiff = Rec_Query.Fields("JfDiff") - Rec_Query.Fields("DfDiff")
        Byrecmoney = Rec_Query.Fields("Inmoney")
        Diff_lv = 0
        
        '差异率计算是否包括本期暂估   不包括减掉
        If Not Cylzg Then
            SqlStr = "SELECT JfDiff,DfDiff,InMoney FROM Chhs_List WHERE WhCode='" & Trim(Rec_Query.Fields("WhCode")) & "' " & _
                     " and MNumber='" & Trim(Rec_Query.Fields("MNumber")) & "' " & _
                     " and KjYear='" & PGKjYear & "' and Period='" & Now_period & "' " & _
                     " and (BillCode='1304' or BillCode='1305'or BillCode='1306') AND StartFlag=0"
            Set Rec_Queryfz = Cw_DataEnvi.DataConnect.Execute(SqlStr)
           
            Do While Not Rec_Queryfz.EOF
                Bydiff = Bydiff - (Val(Rec_Queryfz.Fields("JfDiff")) - Val(Rec_Queryfz.Fields("DfDiff")))
                Byrecmoney = Byrecmoney - Val(Rec_Queryfz.Fields("InMoney"))
                Rec_Queryfz.MoveNext
            Loop
        End If
        
        '本月计划价调整
         SqlStr = "SELECT JfDiff,DfDiff,outMoney FROM Chhs_List WHERE WhCode='" & Trim(Rec_Query.Fields("WhCode")) & "' " & _
                  " and MNumber='" & Trim(Rec_Query.Fields("MNumber")) & "' " & _
                  " and KjYear='" & PGKjYear & "' and Period='" & Now_period & "' " & _
                  " and BillCode='1303'  AND inoutflag=0"
         Set Rec_Queryfz = Cw_DataEnvi.DataConnect.Execute(SqlStr)
        
         Do While Not Rec_Queryfz.EOF
             Byoutmoney = Byoutmoney + Val(Rec_Queryfz.Fields("outMoney"))
             Rec_Queryfz.MoveNext
         Loop
         
        '计算差异率
        If (Qcmoney + Byrecmoney - Byoutmoney) <> 0 Then
            Diff_lv = (Qcdiff + Bydiff) / (Qcmoney + Byrecmoney - Byoutmoney)
            Diff_lv = Format(Diff_lv, "###0.000000")
        End If
        
        If Not Diff_lv = 0 Then
            '生成差异结转单
            BillID = CreatBillID("1307")
            Rectemp.AddNew
            Rectemp.Fields("DiffBillId") = BillID
            Rectemp.Fields("BillCode") = "1307"
            Rectemp.Fields("BillNum") = Str(PGKjYear) + Str(Now_period)
            Rectemp.Fields("WhCode") = Trim(Rec_Query.Fields("WhCode"))
            Rectemp.Fields("MNumber") = Trim(Rec_Query.Fields("MNumber"))
            Rectemp.Fields("Quan") = Val(Rec_Query.Fields("OutQuan")) - Byoutquan
            Rectemp.Fields("PlanMoney") = Val(Rec_Query.Fields("OutMoney")) - Byoutmoney
            Rectemp.Fields("DiffLv") = Format(Diff_lv, "##########.######")
            Rectemp.Fields("DiffMoney") = Format(Val((Rec_Query.Fields("OutMoney") - Byoutmoney) * Format(Diff_lv, "##########.######")), "####." + String(Xtjexsws, "0"))
            Rectemp.Fields("Period") = Now_period
            Rectemp.Fields("KjYear") = PGKjYear
            Rectemp.UpdateBatch
         
            '差异结转单入明细帐
            If Val(Rec_Query.Fields("OutMoney")) - Byoutmoney <> 0 Then
                If Recmx.State = 1 Then Recmx.Close
                Recmx.Open "SELECT BillNum,BillDate,ChalkDate,Period,KjYear,BillCode,WhCode,MNumber,DfDiff,InoutAdjustMainId,MateAcct,DiffAcct,DfAcct from Chhs_List WHERE 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
                
                Recmx.AddNew
                Recmx.Fields("BillNum") = Now_period & "月差异结转"
                Recmx.Fields("InoutAdjustMainId") = BillID
                Recmx.Fields("BillDate") = Xtrq
                Recmx.Fields("ChalkDate") = Xtrq
                Recmx.Fields("Period") = Now_period
                Recmx.Fields("KjYear") = PGKjYear
                Recmx.Fields("BillCode") = "1307"
                Recmx.Fields("WhCode") = Trim(Rec_Query.Fields("WhCode"))
                Recmx.Fields("MNumber") = Trim(Rec_Query.Fields("MNumber"))
                Recmx.Fields("DfDiff") = Format(Val((Rec_Query.Fields("OutMoney") - Byoutmoney) * Format(Diff_lv, "##########.######")), "####." + String(Xtjexsws, "0"))
                
                '填写物差异科目
                SqlStr = "SELECT InvSortcode FROM GY_Material WHERE MNumber='" & Trim(Rec_Query.Fields("MNumber")) & "'"
                Set Rec_Queryfz = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                If Not Rec_Queryfz.EOF Then
                    Sort = Trim(Rec_Queryfz.Fields("InvSortcode") & "")
                End If
                Call MaccCode(Trim(Rec_Query.Fields("WhCode") & ""), Trim(Rec_Query.Fields("MNumber") & ""), Sort)
                Recmx.Fields("DiffAcct") = Xtfhcsfz
                    
                '填写对方科目
                Call DfaccCode("", "", Sort, Trim(Rec_Query.Fields("MNumber") & ""))
                Recmx.Fields("DfAcct") = Xtfhcs
                
                Recmx.UpdateBatch
                
            End If
        End If
        
        Rec_Query.MoveNext
    Loop
         
    Cw_DataEnvi.DataConnect.CommitTrans
    
    Cyljs = True
    
    Set Rectemp = Nothing
    Set Rec_Query = Nothing
    Set Rec_Queryfz = Nothing
    Set Recmx = Nothing
    
    Exit Function
 
 ']以上为用户自定义部分
 
LabelErr:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Label1.Visible = False
    Cyljs = False
    Tsxx = "在差异处理过程中出现未知错误，期末处理失败!"
    Call Xtxxts(Tsxx, 0, 1)
End Function
Private Sub Lst_Cklb_ItemCheck(Index As Integer, Item As Integer)
  
  If Lst_Cklb(0).SelCount = 0 Then
     Com_AvgPrice.Enabled = False
     Com_Qd.Enabled = False
  Else
     Com_AvgPrice.Enabled = True
     Com_Qd.Enabled = True
  End If
  
  If Lst_Cklb(1).SelCount = 0 Then
     Com_Hfqmcl.Enabled = False
  Else
     Com_Hfqmcl.Enabled = True
  End If
  
End Sub
Private Sub NewOutCost()
    Dim Rec_Material As ADODB.Recordset
    Dim Rec_NewOutCost As ADODB.Recordset
    Dim WhCode As String
    
    WhCode = AvgQuery_Cond + " or " + MoveQuery_Cond
    WhCode = Replace(WhCode, "view", "Chhs_Mate", , , vbTextCompare)
    Set Rec_Material = Cw_DataEnvi.DataConnect.Execute("SELECT distinct Chhs_Mate.MNumber FROM Gy_WareHouse INNER JOIN Chhs_Mate ON Gy_WareHouse.WhCode = Chhs_Mate.WhCode WHERE (Gy_WareHouse.PriceMode ='移动平均法' Or Gy_WareHouse.PriceMode = '全月平均法') and Chhs_Mate.OutQuan > 0 and  Chhs_Mate.kjyear='" & PGKjYear & "' and Chhs_Mate.period='" & PGNowmon & "' and " + WhCode)
    If Not Rec_Material.EOF Then
        Rec_Material.MoveFirst
        Do While Not Rec_Material.EOF
            Set Rec_NewOutCost = Cw_DataEnvi.DataConnect.Execute("SELECT Chhs_Mate.MateId,Chhs_Mate.MNumber,Chhs_Mate.OutPrice,Chhs_Mate.OutQuan FROM GY_WareHouse INNER JOIN Chhs_Mate ON Gy_WareHouse.WhCode = Chhs_Mate.WhCode WHERE (Gy_WareHouse.PriceMode ='移动平均法' Or Gy_WareHouse.PriceMode = '全月平均法') and Chhs_Mate.OutQuan > 0 and Chhs_Mate.MNumber='" & Trim(Rec_Material.Fields("MNumber")) & "' and Chhs_Mate.kjyear='" & PGKjYear & "' and Chhs_Mate.period='" & PGNowmon & "' order by Chhs_Mate.MateId")
            If Not Rec_NewOutCost.EOF Then
                Rec_NewOutCost.MoveLast
                Cw_DataEnvi.DataConnect.Execute ("UPDATE GY_Material set NewOutCost=" & Rec_NewOutCost.Fields("OutPrice") & " where MNumber='" & Trim(Rec_NewOutCost.Fields("MNumber")) & "'")
            End If
            Rec_Material.MoveNext
        Loop
    End If
    
    Set Rec_Material = Nothing
    Set Rec_NewOutCost = Nothing
    
End Sub
Private Sub ReturnNewOutCost()
    Dim Rec_Material As ADODB.Recordset
    Dim Rec_NewOutCost As ADODB.Recordset
    
    Dim WhCode As String
    
    WhCode = AvgQuery_Cond + " or " + MoveQuery_Cond
    WhCode = Replace(WhCode, "view", "Chhs_Mate", , , vbTextCompare)
    
    Set Rec_Material = Cw_DataEnvi.DataConnect.Execute("SELECT distinct Chhs_Mate.MNumber FROM Gy_WareHouse INNER JOIN Chhs_Mate ON Gy_WareHouse.WhCode = Chhs_Mate.WhCode WHERE (Gy_WareHouse.PriceMode ='移动平均法' Or Gy_WareHouse.PriceMode = '全月平均法') and Chhs_Mate.OutQuan > 0 and  Chhs_Mate.kjyear='" & PGKjYear & "' and Chhs_Mate.period='" & PGNowmon & "' and " + WhCode)
    If Not Rec_Material.EOF Then
        Rec_Material.MoveFirst
        Do While Not Rec_Material.EOF
            Set Rec_NewOutCost = Cw_DataEnvi.DataConnect.Execute("SELECT Chhs_Mate.MateId,Chhs_Mate.MNumber,Chhs_Mate.OutPrice,Chhs_Mate.OutQuan FROM Gy_WareHouse INNER JOIN Chhs_Mate ON Gy_WareHouse.WhCode = Chhs_Mate.WhCode WHERE (Gy_WareHouse.PriceMode ='移动平均法' Or Gy_WareHouse.PriceMode = '全月平均法') and Chhs_Mate.OutQuan > 0 and Chhs_Mate.MNumber='" & Trim(Rec_Material.Fields("MNumber")) & "' and Chhs_Mate.kjyear='" & PGKjYear & "' and Chhs_Mate.period='" & (PGPrevKjMon) & "' order by Chhs_Mate.MateId")
            If Not Rec_NewOutCost.EOF Then
                Rec_NewOutCost.MoveLast
                Cw_DataEnvi.DataConnect.Execute ("UPDATE GY_Material set NewOutCost=" & Rec_NewOutCost.Fields("OutPrice") & " where MNumber='" & Trim(Rec_NewOutCost.Fields("MNumber")) & "'")
            Else
                Cw_DataEnvi.DataConnect.Execute ("UPDATE GY_Material set NewOutCost='0' where MNumber='" & Trim(Rec_Material.Fields("MNumber")) & "'")
            End If
            Rec_Material.MoveNext
        Loop
    End If
    
    Set Rec_Material = Nothing
    Set Rec_NewOutCost = Nothing
    
End Sub

						