English
+
资源名称：ERPSYS.zip [点击查看]
上传用户：zhpu1995
上传日期：2013-09-06
资源大小：61151k
文件大小：7k
源码类别：
企业管理
开发平台：
Visual Basic
- VERSION 5.00
- Begin VB.Form BOM_BOMCopy
- BorderStyle = 3 'Fixed Dialog
- Caption = "配方复制"
- ClientHeight = 1440
- ClientLeft = 45
- ClientTop = 330
- ClientWidth = 3615
- Icon = "配方管理_配方复制.frx":0000
- KeyPreview = -1 'True
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 1440
- ScaleWidth = 3615
- ShowInTaskbar = 0 'False
- StartUpPosition = 2 '屏幕中心
- Begin VB.CommandButton Cmd_Ok
- Caption = "确定(&O)"
- Height = 300
- Left = 1320
- TabIndex = 1
- Top = 1080
- Width = 1005
- End
- Begin VB.CommandButton Cmd_Cancel
- Caption = "取消(&C)"
- Height = 300
- Left = 2550
- TabIndex = 2
- Top = 1080
- Width = 1005
- End
- Begin VB.Frame Frame1
- Height = 975
- Left = 60
- TabIndex = 3
- Top = 0
- Width = 3495
- Begin VB.TextBox Lrtext
- Height = 300
- Index = 1
- Left = 1020
- MaxLength = 12
- TabIndex = 0
- Top = 540
- Width = 2355
- End
- Begin VB.TextBox Lrtext
- Height = 300
- Index = 0
- Left = 1020
- TabIndex = 6
- Top = 180
- Width = 2355
- End
- Begin VB.Label Label2
- Caption = "新BOM单号:"
- Height = 255
- Left = 120
- TabIndex = 5
- Top = 600
- Width = 1095
- End
- Begin VB.Label Label1
- Caption = "原BOM单号:"
- Height = 255
- Left = 120
- TabIndex = 4
- Top = 240
- Width = 1095
- End
- End
- End
- Attribute VB_Name = "BOM_BOMCopy"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- '**************************************************************************
- '* 模 块 名 称 :配方管理--配方复制
- '* 功 能 描 述 :配方复制
- '* 程序员姓名 :乔进
- '* 最后修改人 :乔进
- '* 最后修改时间:2001/11/30
- '* 备 注:程序中所有依实际情况自定义部分均用[>> <<]括起
- '**************************************************************************
- Dim bBOMCopy As Boolean
- Dim sTemp As String, Tsxx As String, RecTemp As New ADODB.Recordset
- Private Sub Cmd_Cancel_Click()
- Unload Me
- End Sub
- Private Sub cmd_Ok_Click()
- If bBOMCopy Then
- If Len(Trim(LrText(1))) = 0 Then
- Tsxx = "BOM单号不能为空!"
- Call Xtxxts(Tsxx, 0, 1)
- Exit Sub
- End If
- If Trim(LrText(0)) = Trim(LrText(1)) Then
- Tsxx = "BOM单号重复!"
- Call Xtxxts(Tsxx, 0, 1)
- Exit Sub
- End If
- If HaveChinese(LrText(1)) Then
- Tsxx = "BOM单号不能包含汉字!"
- Call Xtxxts(Tsxx, 0, 1)
- Exit Sub
- End If
- Sqlstr = "Select BOMNumber From MRP_BOMMain Where BOMNumber='" & Trim(LrText(1)) & "'"
- Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
- If Not RecTemp.EOF Then
- Tsxx = "BOM单号已经存在!"
- Call Xtxxts(Tsxx, 0, 1)
- Exit Sub
- End If
- Call Sub_PasteBOM(Trim(LrText(0)), Trim(LrText(1)))
- Else
- Tsxx = "没有有效复制配方!"
- Call Xtxxts(Tsxx, 0, 1)
- Exit Sub
- End If
- End Sub
- '复制配方
- Private Sub Sub_PasteBOM(oldBOMNumber As String, newBOMNumber As String)
- Dim newBOMID As String
- Sqlstr = "Select * From MRP_BOMMain Where BOMNumber='" & Trim(oldBOMNumber) & "' "
- Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
- On Error GoTo Errorhand:
- If Not RecTemp.EOF Then
- Cw_DataEnvi.DataConnect.BeginTrans
- newBOMID = CreatBillID("2401")
- '写入主表数据
- Sqlstr = "Insert MRP_BOMMain (BOMMainID,BOMNumber,MNumber,State,DeptCode,Maker,MakeDate,ProPercent) " & _
- " Values ( '" & newBOMID & "','" & newBOMNumber & "','" & Trim(RecTemp!MNumber) & "' ,0 ,'" & Trim(RecTemp!DeptCode & "") & "','" & Xtczy & "' ,'" & Format(Xtrq, "yyyy-mm-dd") & "',100) "
- Cw_DataEnvi.DataConnect.Execute (Sqlstr)
- '建立临时表，同时将要复制的子表的数据写入临时表，然后替换主表ID为新的ID
- Sqlstr = "Select MRP_BOMSub.* Into #MRP_BOMCopyTemp From MRP_BOMSub Left Join MRP_BOMMain On MRP_BOMSub.BOMMainID=MRP_BOMMain.BOMMainID Where MRP_BOMMain.BOMNumber='" & Trim(oldBOMNumber) & "' "
- Cw_DataEnvi.DataConnect.Execute (Sqlstr)
- Sqlstr = "Update #MRP_BOMCopyTemp Set BOMMainID='" & Trim(newBOMID) & "'"
- Cw_DataEnvi.DataConnect.Execute (Sqlstr)
- '将修改后的临时表中得数据写入配方子表中
- Sqlstr = "Insert Into MRP_BOMSub Select BOMSubID ,BOMMainID ,MNumber ,RationNum,WhCode,WastePercent From #MRP_BOMCopyTemp"
- Cw_DataEnvi.DataConnect.Execute (Sqlstr)
- Sqlstr = "Drop Table #MRP_BOMCopyTemp "
- Cw_DataEnvi.DataConnect.Execute (Sqlstr)
- Cw_DataEnvi.DataConnect.CommitTrans
- Xtfhcs = 1
- Tsxx = "复制完成!"
- Call Xtxxts(Tsxx, 0, 4)
- Exit Sub
- Else
- Tsxx = "没有找到当前复制配方,可能已被其它用户删除! "
- Call Xtxxts(Tsxx, 0, 1)
- Exit Sub
- End If
- Errorhand:
- Cw_DataEnvi.DataConnect.RollbackTrans
- Tsxx = "复制过程出现未知错误,复制失败!"
- Call Xtxxts(Tsxx, 0, 1)
- End Sub
- Private Sub Form_KeyPress(KeyAscii As Integer)
- If KeyAscii = vbKeyReturn Then
- SendKeys "{tab}"
- KeyAscii = 0
- End If
- End Sub
- Private Sub Form_Load()
- Xtfhcs = 0
- If BOM_QueryList.bBOMCopy = True Then
- bBOMCopy = True
- sTemp = BOM_QueryList.sString
- LrText(0).Text = sTemp
- LrText(0).BackColor = &H8000000F
- LrText(0).Enabled = False
- cmd_Ok.Enabled = True
- Cmd_Cancel.Enabled = True
- Else
- bBOMCopy = False
- LrText(0) = ""
- LrText(1) = ""
- LrText(0).Enabled = False
- LrText(1).Enabled = False
- LrText(0).BackColor = &H80000005
- LrText(1).BackColor = &H80000005
- cmd_Ok.Enabled = False
- Cmd_Cancel.Enabled = True
- End If
- Me.HelpContextID = 2412002
- End Sub
- Private Sub LrText_Change(Index As Integer)
- Call TextChangeLimit(LrText(1), 2) '去掉无效字符
- End Sub
