+i

VB开发的ERP系统

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Copy_FrmData 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "复制数据"
   ClientHeight    =   4965
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4035
   HelpContextID   =   2213003
   Icon            =   "日常处理_复制数据.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4965
   ScaleWidth      =   4035
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton ComCancel 
      Caption         =   "取消(&C)"
      Height          =   300
      Left            =   3015
      TabIndex        =   4
      Top             =   4575
      Width           =   945
   End
   Begin VB.CommandButton Cmd_OK 
      Caption         =   "复制(&Q)"
      Height          =   300
      Left            =   2040
      TabIndex        =   3
      Top             =   4575
      Width           =   945
   End
   Begin VB.CommandButton Com_All 
      Caption         =   "全选(&A)"
      Height          =   300
      Left            =   1050
      TabIndex        =   2
      Top             =   4575
      Width           =   945
   End
   Begin VB.CommandButton Com_Qing 
      Caption         =   "全清(&L)"
      Height          =   300
      Left            =   75
      TabIndex        =   1
      Top             =   4575
      Width           =   945
   End
   Begin MSComctlLib.TreeView Tre_Sort 
      Height          =   4395
      Left            =   75
      TabIndex        =   0
      Top             =   105
      Width           =   3885
      _ExtentX        =   6853
      _ExtentY        =   7752
      _Version        =   393217
      Style           =   7
      Appearance      =   1
   End
End
Attribute VB_Name = "Copy_FrmData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*******************************************************
'*    模 块 名 称 :复制数据
'*    功 能 描 述 :将不停用、且操作员有操作权限的类别离当前会计期间最近的数据拷到当前会计期间
'*    程序员姓名  :田建秀
'*    最后修改人  :田建秀
'*    最后修改时间:2002/01/04
'*    备        注:
'*******************************************************

Option Explicit
Dim Rsc As New ADODB.Recordset
Dim Sql As String
Dim nodx As Node
Dim i As Integer

Private Sub Com_All_Click()
    With Tre_Sort
        For i = 1 To .Nodes.Count
            .Nodes(i).Checked = True
        Next
    End With
End Sub

Private Sub Cmd_OK_Click()
    '复制数据
    Dim SortId As String
    Dim An As Integer
    With Tre_Sort
        For i = 1 To .Nodes.Count
            If .Nodes(i).Checked = True Then
                An = Xtxxts("工资类别“" & Trim(.Nodes(i).Text) & "”的确需复制吗?", 1, 2)
                If An = 6 Then
                    SortId = Right(Trim(.Nodes(i).Key), Len(Trim(.Nodes(i).Key)) - 1)
                    Call CopyData(SortId, Trim(.Nodes(i).Text))
                End If
            End If
        Next
        
    End With
    Unload Me
End Sub
Private Sub CopyData(SortId As String, SortName As String)
    '判断这一类别是否有数据
    Dim Year1 As Integer
    Dim Month1 As Integer
    If Rsc.State = 1 Then Rsc.Close
    Sql = "select * from pm_Payroll where SortId='" & SortId & "'"
    Set Rsc = Cw_DataEnvi.DataConnect.Execute(Sql)
    If Rsc.EOF Then
        Call Xtxxts("工资类别“" & SortName & "”在工资表中没有数据，不能复制!", 0, 1)
        Exit Sub
    End If
    '当前会计期间是否有数据
    If Rsc.State = 1 Then Rsc.Close
    Sql = "select * from pm_Payroll where Sortid='" & SortId & "'" & _
          " and kjyear=" & Xtyear & " and period=" & Xtmm
    Set Rsc = Cw_DataEnvi.DataConnect.Execute(Sql)
    If Not Rsc.EOF Then
        Call Xtxxts("工资类别“" & SortName & _
            "”在工资表中已有" & Xtyear & "年" & Xtmm & "月的数据，无需复制!", 0, 1)
        Exit Sub
    End If
    '复制数据
    If Rsc.State = 1 Then Rsc.Close
    Sql = " select distinct KjYear,Period from PM_Payroll where SortId='" & SortId & "' order by KjYear,Period desc"
    Set Rsc = Cw_DataEnvi.DataConnect.Execute(Sql)
    If Not Rsc.EOF Then
        Year1 = Rsc!KjYear
        Month1 = Rsc!Period
    End If
    
    On Error GoTo Err1
    Cw_DataEnvi.DataConnect.BeginTrans
    '建立临时表
    Sql = "select * into #Pmp from PM_Payroll where SortId='" & SortId & "'" & _
          " and kjyear=" & Year1 & " and Period=" & Month1
    Cw_DataEnvi.DataConnect.Execute Sql
    
    Sql = " update #Pmp set kjYear=" & Xtyear & ", Period=" & Xtmm
    Cw_DataEnvi.DataConnect.Execute Sql
    '清空清空项、停用项目自动清空
    If Rsc.State = 1 Then Rsc.Close
    Sql = "select FieldName from PM_SortItem p inner join Rs_Items r on " & _
        " p.ItemID=r.ItemID where ClearFlag=1 or HaltFlag=1"
    Set Rsc = Cw_DataEnvi.DataConnect.Execute(Sql)
    Sql = ""
    With Rsc
        If Not .EOF Then
            Sql = "update #Pmp set " & Trim(!FieldName) & "=0"
        
            .MoveNext
            Do While Not .EOF
                Sql = Sql & "," & Trim(!FieldName) & "=0"
                .MoveNext
            Loop
            Set Rsc = Cw_DataEnvi.DataConnect.Execute(Sql)
        End If
    End With
      
       
    Sql = " insert PM_Payroll select * from #Pmp"

    With Cw_DataEnvi.DataConnect
        .Execute Sql
        .Execute "drop table #pmp"
        .CommitTrans
    End With
    Call Xtxxts("工资类别“" & SortName & "”复制成功!", 0, 4)
    Exit Sub
Err1:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Call Xtxxts("工资类别“" & SortName & "”复制不成功!", 0, 4)
    
End Sub
Private Sub Com_Qing_Click()
    With Tre_Sort
        For i = 1 To .Nodes.Count
            .Nodes(i).Checked = False
        Next
    End With
End Sub

Private Sub ComCancel_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    Sql = " and czybm='" & Xtczybm & "'"
    Sql = "select s.sortid,sortName,DataCopy from pm_Sort s ,PM_OpeSort p " & _
        " where s.sortid=p.sortid and sorthalt=0 and DataCopy=1 " & Sql
    Set Rsc = Cw_DataEnvi.DataConnect.Execute(Sql)
    With Tre_Sort
        .Checkboxes = True
        Do While Not Rsc.EOF
            Set nodx = .Nodes.Add(, , "S" & Rsc!SortId, Rsc!SortName)
            If Rsc!DataCopy = True Then
                nodx.Checked = True
            End If
            Rsc.MoveNext
        Loop
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set Rsc = Nothing
End Sub