frmgeneralpartplan1.frm

采用面向负荷控制技术

                     " pardrawingnumber='" & Trim$(pardrawings) & "'" '& " and  productiontype in ('委外加工','自制','组装') "
                  rs1.ActiveConnection = "dsn=dbw;uid=sa"
                  rs1.CursorLocation = adUseClient
                  rs1.CursorType = adOpenKeyset
                  rs1.LockType = adLockOptimistic
                  rs1.Source = sql
                  rs1.Open
                  bool = False
                  If rs1.RecordCount = 0 Then '若没有此部件的产品明细,则退出
                     MsgBox "没有此部件的产品明细", vbExclamation, "提示"
                    bool = True
                    rs1.Close
                    Set rs1 = Nothing
                    Exit Sub
                  End If
                  
                   On Error Resume Next
                    rs1.MoveFirst
                Do Until rs1.EOF
                   If rs1("pargroupamount") <> 0 Then
                           If rs2.RecordCount <> 0 Then '首先判断零部件计划表中是否有本计划,若有则只增加其数量,否则增加一条新记录.
                                    find = False
                                     sql = "select * from t_spgeneralpartplan " & _
                                           "  where  ordercode='" & Trim$(ordercodes) & "' and  workcode='" & Trim$(workcodes) & "' and  drawingnumber='" & Trim$(rs1("pardrawingnumber")) & "'"
                            
                                     If sch.State = adStateOpen Then sch.Close
                                     sch.ActiveConnection = "dsn=dbw;uid=sa"
                                     sch.CursorLocation = adUseClient
                                     sch.CursorType = adOpenKeyset
                                     sch.LockType = adLockOptimistic
                                     sch.Source = sql
                                     sch.Open
                                     If sch.RecordCount <> 0 Then find = True
                           End If
                       
                      If find Then '若发现零部件计划里本计划已存在则增加新计划计划
                            sch("planquantity") = sch("planquantity") + pargroupamounts * rs1("pargroupamount")
                            sch.Update
                      Else '否则增加新计划
                      Set orderrs = Nothing
                      orderrs.ActiveConnection = "dsn=dbw;uid=sa"
                      orderrs.CursorLocation = adUseClient
                      orderrs.CursorType = adOpenKeyset
                      orderrs.LockType = adLockOptimistic
                      orderrs.Source = "select * from t_suborder where  ordercode='" & Trim$(ordercodes) & "'"
                      orderrs.Open
                      
                            rs2.AddNew
                            rs2("workcode") = Trim$(workcodes)
                            rs2("ordercode") = Trim$(ordercodes)
                            rs2("locomotivetype") = CStr(Trim$(rs1("locomotivetype")))
                            rs2("prodrawingnumber") = CStr(Trim$(rs1("prodrawingnumber")))
                            rs2("drawingnumber") = CStr(Trim$(rs1("pardrawingnumber")))
                            rs2("pargroupamount") = Int(rs1("pargroupamount"))
                            rs2("planquantity") = pargroupamounts * Int(rs1("pargroupamount"))
                            rs2("acceptdate") = CDate(orderrs("acceptdate"))
                            rs2("senddate") = CDate(orderrs("senddate"))
                            rs2("note") = Trim$(CStr(note))
                            rs2.Update
                      End If  '将计划加入临时表中

                               myrs.AddNew
                               myrs("workcode") = Trim$(workcodes)
                               myrs("ordercode") = Trim$(ordercodes)
                               myrs("locomotivetype") = CStr(Trim$(rs1("locomotivetype")))
                               myrs("drawingnumber") = CStr(Trim$(rs1("pardrawingnumber")))
                               myrs("pargroupamount") = Int(rs1("pargroupamount"))
                               myrs("planquantity") = pargroupamounts * Int(rs1("pargroupamount"))
                                myrs("note") = Trim$(CStr(note))
                                myrs.Update
                    End If
                              rs1.MoveNext
                Loop
     rs1.Close
  Set rs1 = Nothing
  End Sub


Private Sub cmbddgz_LostFocus()
List1.AddItem (cmbddgz.Text)

End Sub

Private Sub cmbfind_Click()
   Dim sql As String
   sql = "select * from t_suborder where added='否'"
   Set rs = Nothing
   rs.ActiveConnection = "dsn=dbw;uid=sa"
   rs.CursorLocation = adUseClient
   rs.CursorType = adOpenKeyset
   rs.LockType = adLockOptimistic
   rs.Source = sql
   rs.Open
   Set DataGrid1.DataSource = rs
   Call initial(DataGrid1, "定单表")
   Call first(DataGrid1)
 If rs.RecordCount <> 0 Then
    comshchjh.Enabled = True
 End If
End Sub

Private Sub cmddel_Click()
List1.RemoveItem (List1.ListIndex)
End Sub


Private Sub cmdFresh_Click()
  Dim findrs As New ADODB.Recordset
  Set findrs = Nothing
  findrs.ActiveConnection = "dsn=dbw;uid=sa"
  findrs.CursorLocation = adUseClient
  findrs.CursorType = adOpenDynamic
  findrs.LockType = adLockOptimistic
  findrs.Source = "delete from t_submachineload"
  findrs.Open
  Set findrs = Nothing
  findrs.ActiveConnection = "dsn=dbw;uid=sa"
  findrs.CursorLocation = adUseClient
  findrs.CursorType = adOpenDynamic
  findrs.LockType = adLockOptimistic
  findrs.Source = "delete from t_subdaytaskplan"
  findrs.Open
 
 Set rss = Nothing
  rss.ActiveConnection = "dsn=dbw;uid=sa"
  rss.CursorLocation = adUseClient
  rss.CursorType = adOpenDynamic
  rss.LockType = adLockOptimistic
    rss.Source = "select * from t_submachineload"
    rss.Open
  DataGrid3.Refresh
  
  
  Set DataGrid3.DataSource = rss
  Call first(DataGrid3)
  Call initial(DataGrid3, "设备负荷表")
End Sub

Private Sub Comddgz_Click()
    Dim rs1 As New ADODB.Recordset  '用rs来对零件计划标排序并显示之
    'machine()代表机器编号，machine2()代表机器效率machine1()代表机器负荷
    Dim machine() As String, machine1() As Single, machine2() As Single
    Dim timeoccupy  '记录每台设备的时间占用
    Dim rs2 As New ADODB.Recordset '找出相应的产品对应的加工设备号
    Dim rs3 As New ADODB.Recordset '打开打开日生产计划表
    Dim rs5 As New ADODB.Recordset '用来给r表里添加数据
    Dim m As Integer, i As Integer, j As Integer
    Dim quota As Single
    Dim sql As String
    Dim s As String, s1 As String
    s = ""
    s1 = ""
    Dim rst As New ADODB.Recordset
    
    For j = 0 To List1.ListCount - 1
            Set rst = Nothing
            rst.ActiveConnection = "dsn=dbw;uid=sa"
            rst.CursorLocation = adUseClient
            rst.CursorType = adOpenKeyset
            rst.LockType = adLockOptimistic
            rst.Source = "select rulename,note from rules where rulename='" & Trim$(List1.List(j)) & "'"
            rst.Open
            If s = "" Then
                If rst.RecordCount <> 0 And rst("rulename") <> "红签条" Then
                s = s + rst("note")
                End If
            Else
                If rst.RecordCount <> 0 And rst("rulename") <> "红签条" Then
                s = s + "," + rst("note")
                End If
            End If
            '判断是否是红铅条的任务
            If rst("rulename") = "红签条" Then
                s1 = " and note='紧急任务' "
            End If
    Next j
    
    Set rs1 = Nothing
    rs1.ActiveConnection = "dsn=dbw;uid=sa"
    rs1.CursorLocation = adUseClient
    rs1.CursorType = adOpenKeyset
    rs1.LockType = adLockOptimistic
    
    sql = "select * from t_myplantask where added='否'  "
    If s1 <> "" Then
        sql = sql & s1
    End If
    
    If s <> "" Then
        sql = sql & " order by " & s
    End If
    rs1.Source = sql
    rs1.Open

    
  ' Select Case Trim$(cmbddgz.Text)
   'Case "基于交货期"
    'rs1.Source = "select * from t_myplantask where added='否' order by senddate,drawingno,processno"
    
   ' Case "先到达者优先"
        
        'rs1.Source = "select * from t_myplantask where added='否' order by orderdate,drawingno,processno"
   ' Case "加工时间最短者优先"
        'rs1.Source = "select * from t_myplantask where added='否' order by orderdate,drawingno,processno"
   ' Case "红签条"
        'rs1.Source = "select * from t_myplantask where added='否' and bz='紧急任务' order by orderdate,drawingno,processno"
   ' Case "缓冲期"
        'rs1.Source = "select * from t_myplantask where added='否'  order by hcq orderdate,drawingno,processno"
   ' Case "临界比"
        'rs1.Source = "select * from t_myplantask where added='否'  order by ljb orderdate,drawingno,processno"
   'End Select
    If rs1.RecordCount <> 0 Then
         rs1.MoveFirst
         Do Until rs1.EOF
             Set rs2 = Nothing
             rs2.ActiveConnection = "dsn=dbw;uid=sa"
             rs2.CursorLocation = adUseClient
             rs2.CursorType = adOpenKeyset
             rs2.LockType = adLockOptimistic
             rs2.Source = "select machinenumber,status,timeoccupy from t_machineprocess,device  where t_machineprocess.drawingnumber='" & CStr(rs1("drawingno")) & _
                        "'" & "  and t_machineprocess.processnumber='" & CStr(rs1("processno")) & "'  and  t_machineprocess.machinenumber=device.deviceno"
             rs2.Open
             m = rs2.RecordCount
             If m <> 0 Then
                      ReDim machine(m)
                      ReDim machine1(m)
                      ReDim machine2(m)
                      rs2.MoveFirst
                      timeoccupy = rs2("timeoccupy")
                      quota = CSng(timeoccupy)
                      m = 1
                      Do Until rs2.EOF
                            Set rs3 = Nothing '提取每台设备的负荷,工作效率，及设备编号
                            rs3.ActiveConnection = "dsn=dbw;uid=sa"
                            rs3.CursorLocation = adUseClient
                            rs3.CursorType = adOpenKeyset
                            rs3.LockType = adLockOptimistic
                            rs3.Source = "select sum(timeoccupy) as number from t_submachineload where machinenumber='" & Trim$(rs2("machinenumber")) & "' group by machinenumber"
                            rs3.Open
                            
                            machine(m) = rs2("machinenumber") '提取设备编号
                            machine2(m) = rs2("status") '提取设备效率
                            If rs3.RecordCount <> 0 Then
                               rs3.MoveFirst
                              If rs3("number") <> "" Then
                                  machine1(m) = rs3("number") '提取设备负荷
                              Else
                                  machine1(m) = 0
                              End If
                            End If
                            m = m + 1
                            rs2.MoveNext
                     Loop
                 End If
                    Set rs3 = Nothing
                    Set rs2 = Nothing
                If m <> 0 Then
                Call mpop(rs1("planquantity"), quota, machine1(), machine2())    '调用过程进行任务分派
               
                m = UBound(machine())
                For i = 1 To m  '向设备负荷表里添加新数据
                    If c(i) <> 0 Then
                      rss.AddNew
                      rss("workcode") = CStr(rs1("workcode"))
                      rss("ordercode") = CStr(rs1("ordercode"))
                      rss("machinenumber") = CStr(machine(i))
                      rss("processnumber") = CStr(rs1("processno"))
                      rss("drawingnumber") = CStr(rs1("drawingno"))
                      rss("quantity") = CInt(c(i))
                      rss("timeoccupy") = (c(i) * quota) / machine2(i)
                      rss("plandate") = Year(Date) & "-" & Month(Date)
                      rss.Update
                    End If
                 Next i
                  Set rs3 = Nothing
                  rs3.ActiveConnection = "dsn=dbw;uid=sa"
                  rs3.CursorLocation = adUseClient
                  rs3.CursorType = adOpenKeyset
                  rs3.LockType = adLockOptimistic
                  rs3.Source = "t_subdaytaskplan"
                  rs3.Open
                 For i = 1 To m    '向任务表里添加新数据
                    If c(i) <> 0 Then
                     rs3.AddNew
                     rs3("workcode") = CStr(rs1("workcode"))
                     rs3("ordercode") = CStr(rs1("ordercode"))
                     rs3("drawingnumber") = CStr(rs1("drawingno"))
                     rs3("state") = CStr(rs1("processno"))
                     rs3("planquantity") = c(i)
                     rs3("machinecode") = CStr(machine(i))
                     rs3("playdate") = CDate(Date)
                     rs3.Update
                  End If
                 Next i
                 'If (rs1("state") <> rs1("endstate")) Then  '修改零件计划表的任务状态
                 '    rs1("state") = rs1("state") + 5
                 '    rs1.Update
                ' Else
                '    rs1("added") = "是"
                 '   rs1.Update
                 'End If
              'End If
              ' rs1("state") = rs1("state") + 5
             ' rs1.Update
             '  End If
            End If
            rs1.MoveNext