VB开发的ERP系统

                .Fields("DeptCode") = rs_From(0).Fields("DeptCode")                 '计划部门
                .Fields("PersonCode") = rs_From(0).Fields("PersonCode")             '计划人
                .Fields("ExigenceFlag") = rs_From(0).Fields("ExigenceFlag")         '紧急标志
                If Trim(Me.WglrGrid.TextMatrix(i, 1)) <> "" Then
                    .Fields("SupplierCode") = Trim(Me.WglrGrid.TextMatrix(i, 1))    '供应商
                End If
                .Fields("Maker") = Xtczy                                            '制单人
                .Fields("Checker") = Xtczy                                          '审核人
                .Fields("Remark") = Trim(rs_From(0).Fields("Remark") & "")          '备注
                .Fields("Transmitter") = ""                                         '下达人置空
                .Fields("FinishFlag") = 0                                           '完成标志
                .Fields("SplitUniteFlag") = 0                                       '拆合标志
                .Fields("PurPlanStyle") = "2"                                       '不能被生产系统调用
                .Fields("PurPlanMainID") = CreatBillID("1101")                      '单据ID
                .Fields("SplitUniteNum") = Lng_Cfpc                                 '拆分合并过程号
                .UpdateBatch
          
            End With
            '保存从表
            str_SQlSave = "select * from Cg_PurPlanSub where 1=2"
            If rs_Save(1).State = 1 Then rs_Save(1).Close
            rs_Save(1).Open str_SQlSave, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockPessimistic
            
            With rs_Save(1)
                .AddNew
                .Fields("PurPlanMainID") = rs_Save(0).Fields("PurPlanMainID") + 0                       '单据ID
                .Fields("MNumber") = Trim(Me.WglrGrid.TextMatrix(i, Sydz("001", GridStr(), Szzls)))     '物料编码
                .Fields("Quantity") = S2N(Me.WglrGrid.TextMatrix(i, Sydz("006", GridStr(), Szzls)))     '数量
                .Fields("Buyer") = ""                                                                   '采购员
                .Fields("PurPlanSubID") = 1                                                             '子表ID
                .Fields("ProcFactory") = ""                                                             '生产厂家
                .UpdateBatch
                str_Insert = "insert into Cg_SplitUnite(SplitUniteNum,NewPurPlanMainID,NewPurPlanSubID,PurPlanMainID,PurPlanSubID)" & "values( " & Lng_Cfpc & "," & rs_Save(0).Fields("PurPlanMainID") & " ," & rs_Save(1).Fields("PurPlanSubID") & "," & rs_From(0).Fields("PurPlanMainID") & ",1)"
                Cw_DataEnvi.DataConnect.Execute (str_Insert)
            End With
        End If
    Next i
    
    ' 保存剩余单据
    Dim Is_Left As Boolean
    Is_Left = False
    For i = LBound(arrStr_LeftMNum, 1) To UBound(arrStr_LeftMNum, 1)
        If arrDbl_LeftQuan(i) <> 0 Then
            Is_Left = True
            Exit For
        End If
    Next i
    If Is_Left Then
        str_SQlSave = "select * from Cg_PurPlanMain where 1=2"
        If rs_Save(0).State = 1 Then rs_Save(0).Close
        rs_Save(0).Open str_SQlSave, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockPessimistic
        With rs_Save(0)
            .AddNew
            .Fields("PurPlanNum") = CreatBillCode("1101", True)         '单据号
            .Fields("KjYear") = Lng_KjYear                              '会计年度
            .Fields("Period") = Lng_Period                              '会计月份
            .Fields("PurPlanDate") = Format(Xtrq, "yyyy-mm-dd")         '计划日期
            .Fields("PurPlanType") = "拆分生成"                         '计划类型
            .Fields("DeptCode") = rs_From(0).Fields("DeptCode")         '计划部门
            .Fields("PersonCode") = rs_From(0).Fields("PersonCode")     '计划人
            .Fields("ExigenceFlag") = rs_From(0).Fields("ExigenceFlag") '紧急标志
            .Fields("SupplierCode") = rs_From(0).Fields("SupplierCode") '供应商
            .Fields("Maker") = Xtczy                                    '制单人
            .Fields("Checker") = Xtczy                                  '审核人
            .Fields("Remark") = Trim(rs_From(0).Fields("Remark") & "")  '备注
            .Fields("Transmitter") = ""                                 '下达人置空
            .Fields("FinishFlag") = 0                                   '完成标志
            .Fields("SplitUniteFlag") = 0                               '拆合标志
            .Fields("PurPlanStyle") = "2"                               '不能被生产系统调用
            .Fields("PurPlanMainID") = CreatBillID("1101")              '单据ID
            .Fields("SplitUniteNum") = Lng_Cfpc                         '拆分合并过程号
            .UpdateBatch
        End With
        '保存从表
        Lng_Jsq = 1
        For i = LBound(arrStr_LeftMNum, 1) To UBound(arrStr_LeftMNum, 1)
            If arrDbl_LeftQuan(i) <> 0 Then
                str_SQlSave = "select * from Cg_PurPlanSub where 1=2"
                If rs_Save(1).State = 1 Then rs_Save(1).Close
                rs_Save(1).Open str_SQlSave, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockPessimistic
                With rs_Save(1)
                    .AddNew
                    .Fields("PurPlanMainID") = rs_Save(0).Fields("PurPlanMainID") + 0   '单据ID
                    .Fields("MNumber") = arrStr_LeftMNum(i)                             '物料编码
                    .Fields("Quantity") = arrDbl_LeftQuan(i)                            '数量
                    .Fields("Buyer") = ""                                               '采购员
                    .Fields("ProcFactory") = ""                                         '生产厂家
                    .Fields("PurPlanSubID") = Lng_Jsq                                   '子表ID
                    .UpdateBatch
                    str_Insert = "insert into Cg_SplitUnite(SplitUniteNum,NewPurPlanMainID,NewPurPlanSubID,PurPlanMainID,PurPlanSubID)" & "values( " & Lng_Cfpc & "," & rs_Save(0).Fields("PurPlanMainID") & " ," & rs_Save(1).Fields("PurPlanSubID") & "," & rs_From(0).Fields("PurPlanMainID") & "," & Lng_Jsq & ")"
                    Cw_DataEnvi.DataConnect.Execute (str_Insert)
                End With
                Lng_Jsq = Lng_Jsq + 1
            End If
        Next i
        '保存有生产厂家的记录
        Set Rs_Plan = Cw_DataEnvi.DataConnect.Execute("Select * from Cg_V_PlanBill where PurPlanMainID='" & Me.dbl_RecordAutoCode & "' and ProcFactory<>'' ")
        Do While Not Rs_Plan.EOF()
            str_SQlSave = "select * from Cg_PurPlanSub where 1=2"
            If rs_Save(1).State = 1 Then rs_Save(1).Close
            rs_Save(1).Open str_SQlSave, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockPessimistic
            With rs_Save(1)
                .AddNew
                .Fields("PurPlanMainID") = rs_Save(0).Fields("PurPlanMainID") + 0   '单据ID
                .Fields("MNumber") = Rs_Plan.Fields("MNumber")                      '物料编码
                .Fields("Quantity") = Rs_Plan.Fields("Quantity")                    '数量
                .Fields("Buyer") = ""                                               '采购员
                .Fields("PurPlanSubID") = Lng_Jsq                                   '子表ID
                .Fields("ProcFactory") = Rs_Plan.Fields("ProcFactory")              '生产厂家
                .UpdateBatch
                str_Insert = "insert into Cg_SplitUnite(SplitUniteNum,NewPurPlanMainID,NewPurPlanSubID,PurPlanMainID,PurPlanSubID)" & "values( " & Lng_Cfpc & "," & rs_Save(0).Fields("PurPlanMainID") & " ," & Lng_Jsq & "," & rs_From(0).Fields("PurPlanMainID") & "," & Rs_Plan.Fields("PurPlanSubID") & " )"
                Cw_DataEnvi.DataConnect.Execute (str_Insert)
            End With
            Rs_Plan.MoveNext
            Lng_Jsq = Lng_Jsq + 1
        Loop
    Else
    
        '保存有生产厂家的记录
        Set Rs_Plan1 = Cw_DataEnvi.DataConnect.Execute("Select * from Cg_V_PlanBill where PurPlanMainID='" & Me.dbl_RecordAutoCode & "' and ProcFactory<>'' ")
        If Not Rs_Plan1.EOF Then
            str_SQlSave = "select * from Cg_PurPlanMain where 1=2"
            If rs_Save(0).State = 1 Then rs_Save(0).Close
            rs_Save(0).Open str_SQlSave, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockPessimistic
            With rs_Save(0)
                .AddNew
                .Fields("PurPlanNum") = CreatBillCode("1101", True)             '单据号
                .Fields("KjYear") = Lng_KjYear                                  '会计年度
                .Fields("Period") = Lng_Period                                  '会计月份
                .Fields("PurPlanDate") = Format(Xtrq, "yyyy-mm-dd")             '计划日期
                .Fields("PurPlanType") = "拆分生成"                             '计划类型
                .Fields("DeptCode") = rs_From(0).Fields("DeptCode")             '计划部门
                .Fields("PersonCode") = rs_From(0).Fields("PersonCode")         '计划人
                .Fields("ExigenceFlag") = rs_From(0).Fields("ExigenceFlag")     '紧急标志
                .Fields("SupplierCode") = rs_From(0).Fields("SupplierCode")     '供应商
                .Fields("Maker") = Xtczy                                        '制单人
                .Fields("Checker") = Xtczy                                      '审核人
                .Fields("Remark") = Trim(rs_From(0).Fields("Remark") & "")      '备注
                .Fields("PurPlanStyle") = "2"                                   '不能被生产系统调用
                .Fields("Transmitter") = ""                                     '下达人置空
                .Fields("FinishFlag") = 0                                       '完成标志
                .Fields("SplitUniteFlag") = 0                                   '拆合标志
                .Fields("PurPlanMainID") = CreatBillID("1101")                  '单据ID
                .Fields("SplitUniteNum") = Lng_Cfpc                             '拆分合并过程号
                .UpdateBatch
            End With
            '保存从表
            Set Rs_Plan = Cw_DataEnvi.DataConnect.Execute("Select * from Cg_V_PlanBill where PurPlanMainID='" & Me.dbl_RecordAutoCode & "' and ProcFactory<>'' ")
            Lng_Jsq = 1
            Do While Not Rs_Plan.EOF()
                str_SQlSave = "select * from Cg_PurPlanSub where 1=2"
                If rs_Save(1).State = 1 Then rs_Save(1).Close
                rs_Save(1).Open str_SQlSave, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockPessimistic
                With rs_Save(1)
                    .AddNew
                    .Fields("PurPlanMainID") = rs_Save(0).Fields("PurPlanMainID") + 0   '单据ID
                    .Fields("MNumber") = Rs_Plan.Fields("MNumber")                      '物料编码
                    .Fields("Quantity") = Rs_Plan.Fields("Quantity")                    '数量
                    .Fields("Buyer") = ""                                               '采购员
                    .Fields("PurPlanSubID") = Lng_Jsq                                   '子表ID
                    .Fields("ProcFactory") = Rs_Plan.Fields("ProcFactory")              '生产厂家
                    .UpdateBatch
                    str_Insert = "insert into Cg_SplitUnite(SplitUniteNum,NewPurPlanMainID,NewPurPlanSubID,PurPlanMainID,PurPlanSubID)" & "values( " & Lng_Cfpc & "," & rs_Save(0).Fields("PurPlanMainID") & " ," & Lng_Jsq & "," & rs_From(0).Fields("PurPlanMainID") & "," & Rs_Plan.Fields("PurPlanSubID") & " )"
                    Cw_DataEnvi.DataConnect.Execute (str_Insert)
                End With
                Rs_Plan.MoveNext
                Lng_Jsq = Lng_Jsq + 1
            Loop
        End If
    End If
    '隐藏原始单据
    Str_Temp = "select * from Cg_PurPlanMain where PurPlanMainID='" & Me.dbl_RecordAutoCode & "' and Checker=''"
    Set rs_Temp = Cw_DataEnvi.DataConnect.Execute(Str_Temp)
    If Not rs_Temp.EOF() Then
        Call Xtxxts("该计划已经被其他人弃审，不能拆分!", 0, 1)
        Cw_DataEnvi.DataConnect.RollbackTrans
        FnBln_SaveData = False
        Exit Function
    End If
    Set rs_Temp = Nothing
    Str_Temp = "select * from Cg_PurPlanMain where PurPlanMainID='" & Me.dbl_RecordAutoCode & "' and Transmitter<>''"
    Set rs_Temp = Cw_DataEnvi.DataConnect.Execute(Str_Temp)
    If Not rs_Temp.EOF() Then
        Call Xtxxts("该计划已经被其他人下达，不能拆分!", 0, 1)
        Cw_DataEnvi.DataConnect.RollbackTrans
        FnBln_SaveData = False
        Exit Function
    End If
    Set rs_Temp = Nothing
    Str_Temp = "update Cg_PurPlanMain set SplitUniteFlag=2 where PurPlanMainID='" & Me.dbl_RecordAutoCode & "'"
    Cw_DataEnvi.DataConnect.Execute (Str_Temp)
    Cw_DataEnvi.DataConnect.CommitTrans
    Exit Function
    Xtfhcs = "1"
error_manager:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "系统生成出现错误,系统恢复到原来状态!"
    Call Xtxxts(Tsxx, 0, 1)
    FnBln_SaveData = False
End Function

Private Sub Form_KeyPress(KeyAscii As Integer)       '控 制 焦 点 转 移
    Select Case KeyAscii
        Case 39           '屏蔽字符"'"
        KeyAscii = 0
    End Select
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If Shift = 2 Then
        With Me.Tlb_Action
            Select Case KeyCode
                Case vbKeyP
                    If .Buttons("dy").Enabled = True And .Buttons("dy").Visible = True Then
                        Call Tlb_Action_ButtonClick(.Buttons("dy"))
                    End If
            End Select
        End With
    End If
End Sub

Private Sub Form_Load()                              '窗 体 装 入
    Xtrq = Format(Xtrq, "yyyy-mm-dd")

  
    '初始化各种锁值

    
    Changelock = False             '网格行列改变控制锁
    Gdtlock = False                '滚动条滚动控制
    Yxxpdlock = True               '字段有效性判断锁
    Hyxxpdlock = True              '行有效性判断锁
    Wbkbhlock = False              '文本框内容改变锁
   
  
    '报表主标题及报表编码
    
    ReportTitle = "采购计划拆分"
    XtReportCode = "Cg_PlanSplit"
    Load Dyymctbl

  
    '调 入 网 格
    GridCode = "Cg_PlanSplit"          '网格属性编码
    Call BzWgcsh(WglrGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Pmbcsjhs = GridInf(3)
    Fzxwghs = GridInf(4)
    Sfblbzkd = GridInf(5)
    Shsfts = GridInf(6)
    Sfxshjwg = GridInf(7)
    Szzls = WglrGrid.Cols - 1
  
    bln_IsChanged = False
    Xtfhcs = "0"
    With WglrGrid
        .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
        For jsqte = .FixedRows To .Rows - 1
            .RowHeight(jsqte) = Sjhgd
        Next jsqte
  
        .Clear 1
        Changelock = True
        .Select .FixedRows, Qslz
        Changelock = False
    For i = 0 To .Cols - 1
        If i = Sydz("006", GridStr(), Szzls) Then
            .ColAlignment(i) = flexAlignRightTop
        Else
            .ColAlignment(i) = flexAlignCenterCenter
        End If
    Next i
    
    
    End With
    '初始化工具栏，操作状态，显示数据（在由列表过渡到修改状态是用到）
    Call FrmTlbState(Me.PFrmTlbOprState)
    Me.Lab_MakeBill.Caption = Xtczy
    Me.Lab_MakeBill.Tag = Xtczybm
    Call Sub_OperStatus("1")