+

VB开发的ERP系统

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