+

来自「VB开发的ERP系统」· 代码 · 共 1,326 行 · 第 1/4 页

        jsqte = CxbbGrid.FixedRows
        Lab_Content(0) = Trim(MRP_TotalDemandQuery.Combo_Con(0))
        Do While Not .EOF
            CxbbGrid.AddItem ""
            '[>>自定义填充内容
            CxbbGrid.TextMatrix(jsqte, 0) = .Fields("TotalDemandID")                                                            '订单ID(主要用来查询定位用)
            CxbbGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = Trim(Rec_Query!MNumber & "")                            '物料编码
            CxbbGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = Trim(Rec_Query!Mname & "")                              '物料名称
            CxbbGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = Trim(Rec_Query!Model & "")                              '规格型号
            CxbbGrid.TextMatrix(jsqte, Sydz("004", GridStr(), Szzls)) = Trim(Rec_Query!PrimaryUnitName & "")                    '单位
            CxbbGrid.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = Trim(Rec_Query!QuanGross & "")                          '毛需求数量
            CxbbGrid.TextMatrix(jsqte, Sydz("006", GridStr(), Szzls)) = Trim(Rec_Query!QuanWare & "")                           '现存数量
            CxbbGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = Trim(Rec_Query!QuanAllocated & "")                      '已分配量
            CxbbGrid.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)) = Trim(Rec_Query!SafeNumber & "")                         '安全库存
            CxbbGrid.TextMatrix(jsqte, Sydz("009", GridStr(), Szzls)) = Trim(Rec_Query!NetNumber & "")                          '净需求数量
            CxbbGrid.TextMatrix(jsqte, Sydz("010", GridStr(), Szzls)) = Trim(Rec_Query!StockNumber & "")                        '采购数量
            CxbbGrid.TextMatrix(jsqte, Sydz("011", GridStr(), Szzls)) = Trim(Rec_Query!TypeName & "")                           '需求类型
            CxbbGrid.TextMatrix(jsqte, Sydz("012", GridStr(), Szzls)) = Format(Trim(Rec_Query!TotalDate & ""), "yyyy-mm-dd")    '计划到货日期
            CxbbGrid.TextMatrix(jsqte, Sydz("013", GridStr(), Szzls)) = IIf(Rec_Query!IfAdd = True, "追补", "正常")             '是否追补
            CxbbGrid.TextMatrix(jsqte, Sydz("014", GridStr(), Szzls)) = Trim(Rec_Query!TotalMan & "")                           '汇总人
            CxbbGrid.TextMatrix(jsqte, Sydz("015", GridStr(), Szzls)) = Trim(Rec_Query!Checker & "")                            '审核人
            If Rec_Query!IfSum = True Then
                CxbbGrid.TextMatrix(jsqte, Sydz("016", GridStr(), Szzls)) = True                                                '是否生成领料单
            Else
                 CxbbGrid.TextMatrix(jsqte, Sydz("016", GridStr(), Szzls)) = False
            End If
            CxbbGrid.Cell(flexcpBackColor, jsqte, 0, , CxbbGrid.Cols - 1) = Lab_Color(Fn_GetBillState(Rec_Query)).BackColor     '状态色
             
             '<<]
            '设置数据行高度(Fixed)
            CxbbGrid.RowHeight(jsqte) = Sjhgd
     
            '动态集指针加1,同时将计数器加1(Fixed)
            .MoveNext
            jsqte = jsqte + 1
        Loop
    End With

    ']以上为用户自定义部分

End Sub

Private Sub CxbbGrid_DblClick()                                              '用户双击网格调入相应单据
    
    Dim RecTemp As New ADODB.Recordset               '临时使用动态集

    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
        Exit Sub
    End If
    
    Sqlstr = "Select TotalDemandID From MRP_TotalDemand Where TotalDemandID='" & Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) & "' "
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With RecTemp
        If .EOF Then
            Tsxx = "此计划可能已被其他用户删除!"
            Call Xtxxts(Tsxx, 0, 4)
            Exit Sub
        Else
            '调入单据处理窗体
            With MRP_TotalDemand
                
                '填充查询单据标识
                XT_BillID = CxbbGrid.TextMatrix(CxbbGrid.Row, 0)
                Xtcdcsfz = Str_QueryCondi
                
                '设置单据处理为列表查询(修改)状态
                Xtcdcs = "2"
                .Show 1
            End With
            If Xtfhcs = "1" Then
                Tsxx = "计划发生变化,是否刷新计划列表?"
                yhAnswer = Xtxxts(Tsxx, 2, 2)
                If yhAnswer = 1 Then
                    Xt_Wait.Show
                    Xt_Wait.Refresh
   
                    '加快显示速度
                    CxbbGrid.Redraw = False
 
                    '生成查询结果
                    Call Sub_Query(1)
   
                    CxbbGrid.Redraw = True
                    Xt_Wait.Hide
                End If
            End If
        End If
    End With

End Sub

Private Sub Sub_AddBill()                                              '新增单据
   
    With MRP_DependentDemand
   
        '设置单据处理为填制单据状态
        Xtcdcs = "1"
        .Show 1
    End With
       
    If Xtfhcs = "1" Then
        Tsxx = "计划发生变化,是否刷新计划列表?"
        yhAnswer = Xtxxts(Tsxx, 2, 2)
        If yhAnswer = 1 Then
            Xt_Wait.Show
            Xt_Wait.Refresh
   
            '加快显示速度
            CxbbGrid.Redraw = False
 
            '生成查询结果
            Call Sub_Query(1)
   
            CxbbGrid.Redraw = True
            Xt_Wait.Hide
        End If
    End If
   
End Sub

Private Sub Sub_DeleteBill()                                            '删除选中当前单据
    
    Dim YAnswer As Integer
    Dim Lng_BillID As Long           '单据标识
    Dim sPlanMainID As String, kjyear As Integer, Period As Integer, RecTemp As New ADODB.Recordset
    
    
    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
        Exit Sub
    End If
 
    
    
    Tsxx = "请确认是否删除当前周期物料?"
    YAnswer = Xtxxts(Tsxx, 2, 2)
   
    If YAnswer = 1 Then
   
 
        '2.删除单据所有内容
        Lng_BillID = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
        Sqlstr = "Select * From MRP_TotalDemand Where TotalDemandID ='" & Trim(Lng_BillID) & "' "
        Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        If RecTemp.EOF Then
            Tsxx = "没有找到当前单据,可能已被其他用户删除!"
            Call Xtxxts(Tsxx, 0, 1)
            Exit Sub
        End If
        kjyear = RecTemp!kjyear
        Period = RecTemp!Period
        Sqlstr = "Select Count(*) From MRP_TotalDemand Where ( Checker<>'' Or IFAbandon=1)  And kjYear='" & Trim(RecTemp!kjyear & "") & "' And Period='" & Trim(RecTemp!Period & "") & "'"
        Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        If RecTemp.Fields(0) > 0 Then
            Tsxx = "当前周期发现已经审核/废弃物料,物料不能删除!"
            Call Xtxxts(Tsxx, 0, 1)
            Exit Sub
        End If
        
        Sqlstr = " Select Max(Convert(Char(1),IfSum)) From  MRP_TotalDemand Where kjYear='" & kjyear & "' And  Period ='" & Period & "' "
        Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        If RecTemp.Fields(0) > 0 Then
            Tsxx = "当前周期物料已经生成领料申请计划,汇总物料不能删除!"
            Call Xtxxts(Tsxx, 0, 1)
            Exit Sub
        End If
        
        Sqlstr = "Select Max(Convert(Char(1),d.IfComplete)) From Mrp_V_totaldemand_C  m Left Join  MRP_DependentDemandMain d On m.DemandMainID  =d.DepDemandMainID      Where  DemandSource=0 And m.kjYear='" & kjyear & "' And m.Period='" & Period & "' "
        Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        If RecTemp.Fields(0) > 0 Then
            Tsxx = "当前周期相关需求已经完成, 汇总物料不能删除!"
            Call Xtxxts(Tsxx, 0, 1)
            Exit Sub
        End If
        Sqlstr = "Select Max(Convert(Char(1),d.IfComplete)) From Mrp_V_totaldemand_C  m Left Join  MRP_IndependentDemandMain d On m.DemandMainID  =d.IndDemandMainID      Where  DemandSource=1 And m.kjYear='" & kjyear & "' And  m.Period='" & Period & "' "
        Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        If RecTemp.Fields(0) > 0 Then
            Tsxx = "当前周期独立需求已经完成, 汇总物料不能删除!"
            Call Xtxxts(Tsxx, 0, 1)
            Exit Sub
        End If
        
        '进行事务处理
        On Error GoTo Swcwcl
        Cw_DataEnvi.DataConnect.BeginTrans
   
        Sqlstr = "Execute MRP_Sp_DeleteTotalCyc " + Str(kjyear) + "  ,  " + Str(Period)
        Cw_DataEnvi.DataConnect.Execute (Sqlstr)

        Cw_DataEnvi.DataConnect.CommitTrans
        
        '删除网格中单据数据
        CxbbGrid.Clear 1
        CxbbGrid.Rows = CxbbGrid.FixedRows

        Exit Sub
    Else
        Exit Sub
    End If
Swcwcl:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "删除计划过程中出现未知错误,程序自动恢复删除前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Sub
  
End Sub



 
Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
    
    Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
    Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
    Bbxbtgs = 1                                          '报 表 小 标 题 行 数
    Bbbwhgs = 0                                          '报 表 表 尾 行 数
    ReDim Bbxbt(1 To Bbxbtgs)
    ReDim bbxbtzzxs(1 To Bbxbtgs)
    If Bbbwhgs <> 0 Then
        ReDim Bbbwh(1 To Bbbwhgs)
        ReDim Bbbwhzzxs(1 To Bbbwhgs)
    End If
    Bbzbt = ReportTitle
    Bbxbt(1) = Space(10) + Fun_FormatOutPut("计划周期:   " + Trim(Me.Lab_Content(0)), 30)
    bbxbtzzxs(1) = 0                                     '报表行组织形式(0-居左 1-居中 2-居右)
    Call Scyxsjb(CxbbGrid)                               '生成报表数据
    Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
    If Not bbylte Then
        Unload DY_Tybbyldy
    End If

End Sub

Private Sub Sub_Checkbill()
    
    Dim RecTemp As New ADODB.Recordset               '临时使用动态集

    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
        Exit Sub
    End If
    
    Sqlstr = "Select TotalDemandID From MRP_TotalDemand Where TotalDemandID='" & Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) & "' "
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With RecTemp
        If .EOF Then
            Tsxx = "此计划已被其他用户删除!"
            Call Xtxxts(Tsxx, 0, 4)
            Exit Sub
        Else
            '调入单据处理窗体
            With MRP_TotalDemand
                '填充查询单据标识
                XT_BillID = CxbbGrid.TextMatrix(CxbbGrid.Row, 0)
                Xtcdcsfz = Str_QueryCondi
                
                '设置单据处理为列表查询(修改)状态
                Xtcdcs = "3"
                .Show 1
            End With
            If Xtfhcs = "1" Then
                Tsxx = "计划发生变化,是否刷新列表?"
                yhAnswer = Xtxxts(Tsxx, 2, 2)
                If yhAnswer = 1 Then
                    Xt_Wait.Show
                    Xt_Wait.Refresh
   
                    '加快显示速度
                    CxbbGrid.Redraw = False
 
                    '生成查询结果
                    Call Sub_Query(1)
   
                    CxbbGrid.Redraw = True
                    Xt_Wait.Hide
                End If
            End If
        End If
    End With
End Sub

Private Sub Sub_DivMonth(InPara As String, Out1 As Integer, Out2 As Integer)
    Dim Pos1 As Integer
    Pos1 = InStr(1, InPara, ".")
    Out1 = Val(Left(InPara, Pos1 - 1))
    Out2 = Right(InPara, Len(InPara) - Pos1)
End Sub

'Return Bill State
Private Function Fn_GetBillState(Rect As Recordset) As Integer
    Dim State As Integer
    
    State = 0
    If Not Rect.EOF Then
        For jsqte = 1 To 3
            Select Case jsqte
                Case 1
                    If Rect!Checker <> "" Then
                        State = 1
                    Else
                        Exit For
                    End If
                Case 2
                    If Rect!IfTransack = True Then
                        State = 2
                    Else
                        Exit For
                    End If
                    
                Case 3
                    If Rect!IfComplete = True Then
                        State = 3
                    Else
                        Exit For
                    End If
                
            End Select
        Next jsqte
    End If
    If Rect!IfAbandon = True Then
        Fn_GetBillState = 4
    Else
        Fn_GetBillState = State
    End If
End Function