VERSION 5.00
Begin VB.Form frmOrderReports 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Отчеты"
   ClientHeight    =   7095
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   7395
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   7095
   ScaleWidth      =   7395
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin VB.CommandButton btnLimitki 
      Caption         =   "Отчет"
      Height          =   420
      Left            =   6210
      TabIndex        =   33
      Top             =   5490
      Width           =   915
   End
   Begin VB.TextBox edStatus 
      BackColor       =   &H8000000F&
      BorderStyle     =   0  'None
      Height          =   240
      Left            =   90
      TabIndex        =   31
      TabStop         =   0   'False
      Top             =   6750
      Width           =   7170
   End
   Begin VB.CommandButton btnProcessedUnitsNow 
      Caption         =   "Отчет"
      Height          =   420
      Left            =   6210
      TabIndex        =   27
      Top             =   2745
      Width           =   915
   End
   Begin VB.CommandButton btnOrderProcessedReport12 
      Caption         =   "План 2"
      Height          =   420
      Left            =   6210
      TabIndex        =   24
      Top             =   2295
      Width           =   915
   End
   Begin VB.Frame Frame2 
      Caption         =   "Склад"
      Height          =   1770
      Left            =   180
      TabIndex        =   7
      Top             =   4320
      Width           =   7080
      Begin VB.CommandButton btnStoreMaterial 
         Caption         =   "Отчет"
         Height          =   420
         Left            =   6030
         TabIndex        =   22
         Top             =   675
         Width           =   915
      End
      Begin VB.CommandButton btnStoreUnits 
         Caption         =   "Отчет"
         Height          =   420
         Left            =   6030
         TabIndex        =   8
         Top             =   180
         Width           =   915
      End
      Begin VB.Label Label11 
         Caption         =   "Состояние склада по заказам"
         Height          =   240
         Left            =   315
         TabIndex        =   34
         Top             =   1305
         Width           =   2535
      End
      Begin VB.Label Label6 
         Caption         =   "Запасы на основное производство"
         Height          =   240
         Left            =   315
         TabIndex        =   23
         Top             =   832
         Width           =   2715
      End
      Begin VB.Label Label5 
         Caption         =   "Склад готовой продукции"
         Height          =   285
         Left            =   315
         TabIndex        =   21
         Top             =   315
         Width           =   2265
      End
   End
   Begin VB.TextBox edOrderByingEndDate 
      BeginProperty DataFormat 
         Type            =   1
         Format          =   "d MMM yyyy"
         HaveTrueFalseNull=   0
         FirstDayOfWeek  =   0
         FirstWeekOfYear =   0
         LCID            =   1049
         SubFormatType   =   3
      EndProperty
      Height          =   330
      Left            =   2340
      Locked          =   -1  'True
      TabIndex        =   20
      Top             =   450
      Width           =   1005
   End
   Begin VB.TextBox edOrderProcessedEndDate 
      BeginProperty DataFormat 
         Type            =   1
         Format          =   "d MMM yyyy"
         HaveTrueFalseNull=   0
         FirstDayOfWeek  =   0
         FirstWeekOfYear =   0
         LCID            =   1049
         SubFormatType   =   3
      EndProperty
      Height          =   330
      Left            =   2340
      Locked          =   -1  'True
      TabIndex        =   19
      Top             =   1890
      Width           =   1005
   End
   Begin VB.CommandButton btnClose 
      Cancel          =   -1  'True
      Caption         =   "Закрыть"
      Height          =   375
      Left            =   3015
      TabIndex        =   16
      Top             =   6255
      Width           =   1230
   End
   Begin VB.TextBox edOrderProcessedStartDate 
      BeginProperty DataFormat 
         Type            =   1
         Format          =   "d MMM yyyy"
         HaveTrueFalseNull=   0
         FirstDayOfWeek  =   0
         FirstWeekOfYear =   0
         LCID            =   1049
         SubFormatType   =   3
      EndProperty
      Height          =   330
      Left            =   540
      Locked          =   -1  'True
      TabIndex        =   13
      Top             =   1890
      Width           =   1005
   End
   Begin VB.CommandButton btnOrderProcessedStartDate 
      Caption         =   ">>"
      Height          =   330
      Left            =   1575
      TabIndex        =   12
      Top             =   1890
      Width           =   330
   End
   Begin VB.CommandButton btnOrderProcessedEndDate 
      Caption         =   ">>"
      Height          =   330
      Left            =   3375
      TabIndex        =   11
      Top             =   1890
      Width           =   330
   End
   Begin VB.CommandButton btnOrderProcessedReport1 
      Caption         =   "План 1"
      Height          =   420
      Left            =   6210
      TabIndex        =   10
      Top             =   1845
      Width           =   915
   End
   Begin VB.CommandButton btnOrderByingEndDate 
      Caption         =   ">>"
      Height          =   330
      Left            =   3375
      TabIndex        =   3
      Top             =   450
      Width           =   330
   End
   Begin VB.CommandButton btnOrderByingStartDate 
      Caption         =   ">>"
      Height          =   330
      Left            =   1575
      TabIndex        =   2
      Top             =   450
      Width           =   330
   End
   Begin VB.TextBox edOrderByingStartDate 
      BeginProperty DataFormat 
         Type            =   1
         Format          =   "d MMM yyyy"
         HaveTrueFalseNull=   0
         FirstDayOfWeek  =   0
         FirstWeekOfYear =   0
         LCID            =   1049
         SubFormatType   =   3
      EndProperty
      Height          =   330
      Left            =   540
      Locked          =   -1  'True
      TabIndex        =   1
      Top             =   450
      Width           =   1005
   End
   Begin VB.CommandButton btnOrderByingReport 
      Caption         =   "План"
      Height          =   420
      Left            =   6210
      TabIndex        =   0
      Top             =   405
      Width           =   915
   End
   Begin VB.Frame Frame1 
      Caption         =   "Закупаемые объекты"
      Height          =   1275
      Left            =   180
      TabIndex        =   4
      Top             =   180
      Width           =   7080
      Begin VB.CommandButton btnByingUnitsNow 
         Caption         =   "Отчет"
         Height          =   420
         Left            =   6030
         TabIndex        =   18
         Top             =   675
         Width           =   915
      End
      Begin VB.ComboBox cbWorker 
         Height          =   315
         Left            =   3960
         Style           =   2  'Dropdown List
         TabIndex        =   5
         Top             =   270
         Width           =   1905
      End
      Begin VB.Label Label4 
         Caption         =   "Состояние по объектам на текущий момент"
         Height          =   285
         Left            =   90
         TabIndex        =   17
         Top             =   765
         Width           =   3570
      End
      Begin VB.Label Label3 
         Caption         =   "до:"
         Height          =   195
         Left            =   1890
         TabIndex        =   15
         Top             =   315
         Width           =   240
      End
      Begin VB.Label Label2 
         Caption         =   "От:"
         Height          =   240
         Left            =   90
         TabIndex        =   14
         Top             =   315
         Width           =   240
      End
      Begin VB.Label Label1 
         Caption         =   "отв."
         Height          =   240
         Left            =   3600
         TabIndex        =   6
         Top             =   315
         Width           =   330
      End
   End
   Begin VB.Frame Frame4 
      Caption         =   "Производимые объекты"
      Height          =   2220
      Left            =   180
      TabIndex        =   9
      Top             =   1530
      Width           =   7080
      Begin VB.ComboBox cbOrders 
         Height          =   315
         Left            =   3420
         Style           =   2  'Dropdown List
         TabIndex        =   37
         Top             =   1710
         Width           =   2490
      End
      Begin VB.CommandButton btnProcessUnits 
         Caption         =   "Отчет"
         Height          =   375
         Left            =   6030
         TabIndex        =   36
         Top             =   1665
         Width           =   915
      End
      Begin VB.ComboBox cbOtdel 
         Height          =   315
         ItemData        =   "frmOrderReports.frx":0000
         Left            =   3960
         List            =   "frmOrderReports.frx":0002
         Style           =   2  'Dropdown List
         TabIndex        =   29
         Top             =   360
         Width           =   1905
      End
      Begin VB.Label Label12 
         Caption         =   "Текущее состояние изготовления узлов"
         Height          =   285
         Left            =   180
         TabIndex        =   35
         Top             =   1755
         Width           =   3210
      End
      Begin VB.Label Label10 
         Caption         =   "цех"
         Height          =   240
         Left            =   3645
         TabIndex        =   30
         Top             =   405
         Width           =   375
      End
      Begin VB.Label Label9 
         Caption         =   "Состояние по объектам на текущий момент"
         Height          =   285
         Left            =   180
         TabIndex        =   28
         Top             =   1305
         Width           =   3570
      End
      Begin VB.Label Label8 
         Caption         =   "до:"
         Height          =   240
         Left            =   1890
         TabIndex        =   26
         Top             =   405
         Width           =   240
      End
      Begin VB.Label Label7 
         Caption         =   "От:"
         Height          =   240
         Left            =   90
         TabIndex        =   25
         Top             =   405
         Width           =   285
      End
   End
   Begin VB.Label labStatus 
      BorderStyle     =   1  'Fixed Single
      Height          =   330
      Left            =   0
      TabIndex        =   32
      Top             =   6705
      Width           =   7350
   End
End
Attribute VB_Name = "frmOrderReports"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Private Sub btnByingUnitsNow_Click()
   On Error GoTo SubErrorHandler
   Screen.MousePointer = vbHourglass
   
   If Not CreateStubTable(edStatus) Then GoTo SubExit
     
   SetStatusMessageForControl edStatus, msgMain, "Подготовка данных..."
   
   ' подготовка данных
   MainDocument.DBConnection.Execute _
      "INSERT INTO tblTByingReport ( timeToBe, keyUnit ) " & _
      "SELECT DISTINCT tblDByingUnits.timeToBe, tblDByingUnits.keyUnit " & _
      "FROM tblDOrders INNER JOIN (tblSUnits INNER JOIN tblDByingUnits ON tblSUnits.keyUnit = tblDByingUnits.keyUnit) ON tblDOrders.keyOrder = tblDByingUnits.keyOrder " & _
      "WHERE (((tblDByingUnits.timeToBe)<=#" & _
      CStr(Day(Date)) + "/" + CStr(Month(Date)) + "/" + CStr(Year(Date)) & _
      "#) AND ((tblDByingUnits.bReady)=False));"
   
   SetStatusMessageForControl edStatus, msgMain, "Создание отчета..."
   
   MainDocument.WaitExecuteFinished
   Dim de As deIMF
   Set de = New deIMF
   de.IMF.ConnectionString = "Provider=MSDataShape.1;Persist Security Info=True;Data Source='" & MainDocument.DBName & "';Data Provider=MICROSOFT.JET.OLEDB.4.0"
   
   Dim rep As New repByingUnitsNow
   Set rep.DataSource = de
   rep.Show vbModal, Me

SubExit:
   Set rep = Nothing
   Set de = Nothing
   Screen.MousePointer = vbDefault
   SetStatusMessageForControl edStatus, msgClearAll
   Exit Sub

SubErrorHandler:
   Screen.MousePointer = vbDefault
   Dim msg As String
   msg = "Номер: " & Err.Number
   msg = msg + vbNewLine + "Описание: " & Err.Description

   MsgBox msg, vbExclamation, "Ошибка!", Err.HelpFile, Err.HelpContext
   GoTo SubExit
End Sub

Private Sub btnClose_Click()
   Unload Me
End Sub

Private Sub btnLimitki_Click()

   On Error GoTo SubErrorHandler
   Screen.MousePointer = vbHourglass
   
   If Not CreateStubTable(edStatus) Then GoTo SubExit
     
   SetStatusMessageForControl edStatus, msgMain, "Подготовка данных..."
   
   On Error Resume Next
   Dim nOrder As Long
   nOrder = cbOrders.ItemData(cbOrders.ListIndex)
   On Error GoTo SubErrorHandler
      
   MainDocument.DBConnection.Execute _
      "INSERT INTO tblTByingReport ( keyUnit, dQuantity, keyOrder, dPrice ) " & _
      "SELECT tblDStoredUnits.keyUnit, tblDStoredUnits.dQuantity, tblDStoredUnits.keyOrder, tblSOtdel.keyOtdel  " & _
      "FROM tblSUnits INNER JOIN (tblSOtdel INNER JOIN tblDStoredUnits ON tblSOtdel.keyOtdel = tblDStoredUnits.keyOtdel) ON tblSUnits.keyUnit = tblDStoredUnits.keyUnit " & _
      "Where (((tblDStoredUnits.keyOrder) Is Not Null) And ((tblSUnits.keyProcLevel) = 4 Or (tblSUnits.keyProcLevel) = 5))"
   
   SetStatusMessageForControl edStatus, msgMain, "Создание отчета..."
   
   MainDocument.WaitExecuteFinished
   Dim de As deIMF
   Set de = New deIMF
   de.IMF.ConnectionString = "Provider=MSDataShape.1;Persist Security Info=True;Data Source='" & MainDocument.DBName & "';Data Provider=MICROSOFT.JET.OLEDB.4.0"
   
   ' определим тип отчета
   Dim repAll As New repLimitki
   
   Set repAll.DataSource = de
   repAll.Show vbModal, Me
   Set repAll = Nothing

SubExit:
   Set de = Nothing
   SetStatusMessageForControl edStatus, msgClearAll
   Screen.MousePointer = vbDefault
   Exit Sub

SubErrorHandler:
   Dim msg As String
   msg = "Номер: " & Err.Number
   msg = msg + vbNewLine + "Описание: " & Err.Description

   MsgBox msg, vbExclamation, "Ошибка!", Err.HelpFile, Err.HelpContext
   GoTo SubExit
End Sub

Private Sub btnOrderByingEndDate_Click()
   On Error Resume Next

   Dim frm As New frmCalendar
   frm.MSCal = edOrderByingEndDate
   frm.Show vbModal
   If frm.bOK = True Then
      edOrderByingEndDate = frm.userDate
      edOrderProcessedEndDate = frm.userDate
   End If
   Set frm = Nothing
End Sub

Private Sub btnOrderByingReport_Click()
   On Error GoTo SubErrorHandler
   Screen.MousePointer = vbHourglass
   
   If Not CreateStubTable(edStatus) Then GoTo SubExit
     
   SetStatusMessageForControl edStatus, msgMain, "Подготовка данных..."
   
   On Error Resume Next
   Dim nWorker As Long
   nWorker = cbWorker.ItemData(cbWorker.ListIndex)
   On Error GoTo SubErrorHandler
   
   If nWorker = 0 Then
      ' определение кол-ва необходимых объектов для заказа
      MainDocument.DBConnection.Execute _
         "INSERT INTO tblTByingReport ( keyUnit, dQuantity, timeToBe, dPrice ) " & _
         "SELECT tblDByingUnits.keyUnit, IIf(tblDStoredUnits.dQuantity,IIf(tblDStoredUnits.dQuantity>=Sum(tblDByingUnits.dQuantity),0,Sum(tblDByingUnits.dQuantity)-tblDStoredUnits.dQuantity),Sum(tblDByingUnits.dQuantity)) AS dQuantity, Min(tblDByingUnits.timeToBe) AS timeToBe, tblSPurchaseUnits.dPrice " & _
         "FROM tblDStoredUnits RIGHT JOIN (tblDByingUnits INNER JOIN tblSPurchaseUnits ON tblDByingUnits.keyUnit = tblSPurchaseUnits.keyUnit) ON tblDStoredUnits.keyUnit = tblDByingUnits.keyUnit " & _
         "WHERE (((tblDByingUnits.timeToBe) >= #" & _
         CStr(Month(edOrderByingStartDate)) + "/" + CStr(Day(edOrderByingStartDate)) + "/" + CStr(Year(edOrderByingStartDate)) & _
         "# And (tblDByingUnits.timeToBe) <= #" & _
         CStr(Month(edOrderByingEndDate)) + "/" + CStr(Day(edOrderByingEndDate)) + "/" + CStr(Year(edOrderByingEndDate)) & _
         "#))" & _
         "GROUP BY tblDByingUnits.keyUnit, tblSPurchaseUnits.dPrice, tblDStoredUnits.dQuantity"
      
   Else
      ' обработка объектов
      
      
      MainDocument.DBConnection.Execute _
         "INSERT INTO tblTByingReport ( keyUnit, dQuantity, timeToBe, dPrice ) " & _
         "SELECT tblDByingUnits.keyUnit, IIf(tblDStoredUnits.dQuantity,IIf(tblDStoredUnits.dQuantity>=Sum(tblDByingUnits.dQuantity),0,Sum(tblDByingUnits.dQuantity)-tblDStoredUnits.dQuantity),Sum(tblDByingUnits.dQuantity)) AS dQuantity, Min(tblDByingUnits.timeToBe) AS timeToBe, tblSPurchaseUnits.dPrice " & _
         "FROM tblSPurchaseGroups INNER JOIN (tblDStoredUnits RIGHT JOIN (tblDByingUnits INNER JOIN tblSPurchaseUnits ON tblDByingUnits.keyUnit = tblSPurchaseUnits.keyUnit) ON tblDStoredUnits.keyUnit = tblDByingUnits.keyUnit) ON tblSPurchaseGroups.keyPurchaseGroup = tblSPurchaseUnits.keyPurchaseGroup " & _
         "Where (((tblDByingUnits.timeToBe) >= #" & _
         CStr(Month(edOrderByingStartDate)) + "/" + CStr(Day(edOrderByingStartDate)) + "/" + CStr(Year(edOrderByingStartDate)) & _
         "# And (tblDByingUnits.timeToBe) <= #" & _
         CStr(Month(edOrderByingEndDate)) + "/" + CStr(Day(edOrderByingEndDate)) + "/" + CStr(Year(edOrderByingEndDate)) & _
         "#)) " & _
         "GROUP BY tblDByingUnits.keyUnit, tblSPurchaseUnits.dPrice, tblDStoredUnits.dQuantity, tblSPurchaseGroups.keyWorker " & _
         "HAVING (((tblSPurchaseGroups.keyWorker)=" & nWorker & "))"
      End If

   ' определение необходимого кол-ва объектов с учетом запаса и мин партии
   If GetSetting(App.Title, "DataBaseOption", "UseReserv", 0) = 0 Then
      MainDocument.DBConnection.Execute _
         "UPDATE tblTByingReport INNER JOIN tblSPurchaseUnits ON tblTByingReport.keyUnit = tblSPurchaseUnits.keyUnit SET tblTByingReport.dQuantity = IIf(tblTByingReport.dQuantity>tblSPurchaseUnits.dMinLot,tblTByingReport.dQuantity,tblSPurchaseUnits.dMinLot) WHERE (((tblSPurchaseUnits.bBuyOnlyDivisibleByMinLot)=FALSE))"
      MainDocument.DBConnection.Execute _
         "UPDATE tblTByingReport INNER JOIN tblSPurchaseUnits ON tblTByingReport.keyUnit = tblSPurchaseUnits.keyUnit SET tblTByingReport.dQuantity = ((Int(tblTByingReport.dQuantity/tblSPurchaseUnits.dMinLot)+1)*tblSPurchaseUnits.dMinLot) WHERE (((tblSPurchaseUnits.bBuyOnlyDivisibleByMinLot)=TRUE))"
   Else
      MainDocument.DBConnection.Execute _
         "UPDATE tblTByingReport INNER JOIN tblSPurchaseUnits ON tblTByingReport.keyUnit = tblSPurchaseUnits.keyUnit SET tblTByingReport.dQuantity = IIf(tblTByingReport.dQuantity+tblSPurchaseUnits.dReserveStock>tblSPurchaseUnits.dMinLot,tblTByingReport.dQuantity+tblSPurchaseUnits.dReserveStock,tblSPurchaseUnits.dMinLot) WHERE (((tblSPurchaseUnits.bBuyOnlyDivisibleByMinLot)=FALSE))"
      MainDocument.DBConnection.Execute _
         "UPDATE tblTByingReport INNER JOIN tblSPurchaseUnits ON tblTByingReport.keyUnit = tblSPurchaseUnits.keyUnit SET tblTByingReport.dQuantity = ((Int((tblTByingReport.dQuantity+tblSPurchaseUnits.dReserveStock)/tblSPurchaseUnits.dMinLot)+1)*tblSPurchaseUnits.dMinLot) WHERE (((tblSPurchaseUnits.bBuyOnlyDivisibleByMinLot)=TRUE))"
   End If
   
   SetStatusMessageForControl edStatus, msgMain, "Создание отчета..."
   
   MainDocument.WaitExecuteFinished
   Dim de As deIMF
   Set de = New deIMF
   de.IMF.ConnectionString = "Provider=MSDataShape.1;Persist Security Info=True;Data Source='" & MainDocument.DBName & "';Data Provider=MICROSOFT.JET.OLEDB.4.0"
   
   ' отчета
   Dim repAll As New repByingUnits
   
   Set repAll.DataSource = de
   repAll.Show vbModal, Me
   Set repAll = Nothing

SubExit:
   Set de = Nothing
   SetStatusMessageForControl edStatus, msgClearAll
   Screen.MousePointer = vbDefault
   Exit Sub

SubErrorHandler:
   Dim msg As String
   msg = "Номер: " & Err.Number
   msg = msg + vbNewLine + "Описание: " & Err.Description

   MsgBox msg, vbExclamation, "Ошибка!", Err.HelpFile, Err.HelpContext
   GoTo SubExit
End Sub

Private Sub btnOrderByingStartDate_Click()
   On Error Resume Next
   
   Dim frm As New frmCalendar
   frm.MSCal = edOrderByingStartDate
   frm.Show vbModal
   If frm.bOK = True Then
      edOrderByingStartDate = frm.userDate
      edOrderProcessedStartDate = frm.userDate
   End If
   Set frm = Nothing
End Sub

Private Sub btnOrderProcessedEndDate_Click()
   btnOrderByingEndDate_Click
End Sub

Private Sub btnOrderProcessedReport1_Click()
   CreateProcessedUnitsReport 1
End Sub

Private Sub btnOrderProcessedReport12_Click()
   CreateProcessedUnitsReport 2
End Sub

Private Sub btnOrderProcessedStartDate_Click()
   btnOrderByingStartDate_Click
End Sub

Private Sub btnProcessedUnitsNow_Click()
   On Error GoTo SubErrorHandler
   Screen.MousePointer = vbHourglass
   
   If Not CreateStubTable(edStatus) Then GoTo SubExit
     
   SetStatusMessageForControl edStatus, msgMain, "Подготовка данных..."
   
   ' подшотовка данных
   MainDocument.DBConnection.Execute _
      "INSERT INTO tblTByingReport ( timeToBe, keyUnit ) " & _
      "SELECT DISTINCT tblDProcessedUnits.timeEnd, tblDProcessedUnits.keyUnit " & _
      "FROM tblSUnits INNER JOIN (tblDOrders INNER JOIN tblDProcessedUnits ON tblDOrders.keyOrder = tblDProcessedUnits.keyOrder) ON tblSUnits.keyUnit = tblDProcessedUnits.keyUnit " & _
      "WHERE (((tblDProcessedUnits.timeEnd)<=#" & _
      CStr(Month(Date)) + "/" + CStr(Day(Date)) + "/" + CStr(Year(Date)) & _
      "#) AND ((tblDProcessedUnits.bReady)=False));"
   
   SetStatusMessageForControl edStatus, msgMain, "Создание отчета..."
   
   MainDocument.WaitExecuteFinished
   Dim de As deIMF
   Set de = New deIMF
   de.IMF.ConnectionString = "Provider=MSDataShape.1;Persist Security Info=True;Data Source='" & MainDocument.DBName & "';Data Provider=MICROSOFT.JET.OLEDB.4.0"
   
   Dim rep As New repProcessedUnitsNow
   Set rep.DataSource = de
   rep.Show vbModal, Me

SubExit:
   Set rep = Nothing
   Set de = Nothing
   SetStatusMessageForControl edStatus, msgClearAll
   Screen.MousePointer = vbDefault
   Exit Sub

SubErrorHandler:
   Screen.MousePointer = vbDefault
   Dim msg As String
   msg = "Номер: " & Err.Number
   msg = msg + vbNewLine + "Описание: " & Err.Description

   MsgBox msg, vbExclamation, "Ошибка!", Err.HelpFile, Err.HelpContext
   GoTo SubExit
End Sub

Private Sub btnProcessUnits_Click()
   If cbOrders.ListIndex < 0 Then
      MsgBox "Выберите заказ", vbOKOnly, "Ошибка!"
      GoTo SubExit
   End If
   
   Screen.MousePointer = vbHourglass
   
   Dim cls As New CollectionOfProcessedUnitsForOrder
   If Not cls.Init(cbOrders.ItemData(cbOrders.ListIndex), edStatus) Then
      GoTo SubExit
   End If
   
   SetStatusMessageForControl edStatus, msgMain, "Создание отчета..."
   MainDocument.WaitExecuteFinished
   
   Dim de As deIMF
   Set de = New deIMF
   de.IMF.ConnectionString = "Provider=MSDataShape.1;Persist Security Info=True;Data Source='" & MainDocument.DBName & "';Data Provider=MICROSOFT.JET.OLEDB.4.0"
   
   Dim rep As New repProcessedUnitsForOrder
   Set rep.DataSource = de
   rep.Show vbModal, Me

SubExit:
   Set rep = Nothing
   Set de = Nothing
   Screen.MousePointer = vbDefault
   SetStatusMessageForControl edStatus, msgClearAll
   Exit Sub

SubErrorHandler:
   Screen.MousePointer = vbDefault
   Dim msg As String
   msg = "Номер: " & Err.Number
   msg = msg + vbNewLine + "Описание: " & Err.Description

   MsgBox msg, vbExclamation, "Ошибка!", Err.HelpFile, Err.HelpContext
   GoTo SubExit
   
'2. для всех выбранных узлов составить его состав
'3. определить для 1 сколько всего надо
'4. определить где расположены детали 2 по цехам и их кол-во

End Sub

Private Sub btnStoreMaterial_Click()
   On Error GoTo SubErrorHandler
   Screen.MousePointer = vbHourglass
   
   SetStatusMessageForControl edStatus, msgMain, "Создание отчета..."
   
   Dim de As deIMF
   Set de = New deIMF
   de.IMF.ConnectionString = "Provider=MSDataShape.1;Persist Security Info=True;Data Source='" & MainDocument.DBName & "';Data Provider=MICROSOFT.JET.OLEDB.4.0"
   
   Dim rep As New repStoredMaterials
   Set rep.DataSource = de
   rep.Show vbModal, Me

SubExit:
   Set rep = Nothing
   Set de = Nothing
   Screen.MousePointer = vbDefault
   SetStatusMessageForControl edStatus, msgClearAll
   Exit Sub

SubErrorHandler:
   Screen.MousePointer = vbDefault
   Dim msg As String
   msg = "Номер: " & Err.Number
   msg = msg + vbNewLine + "Описание: " & Err.Description

   MsgBox msg, vbExclamation, "Ошибка!", Err.HelpFile, Err.HelpContext
   GoTo SubExit
End Sub

Private Sub btnStoreUnits_Click()
   On Error GoTo SubErrorHandler
   Screen.MousePointer = vbHourglass
   
   SetStatusMessageForControl edStatus, msgMain, "Создание отчета..."
   
   Dim de As deIMF
   Set de = New deIMF
   de.IMF.ConnectionString = "Provider=MSDataShape.1;Persist Security Info=True;Data Source='" & MainDocument.DBName & "';Data Provider=MICROSOFT.JET.OLEDB.4.0"
   
   Dim rep As New repStoredUnits
   Set rep.DataSource = de
   
   rep.Show vbModal, Me

SubExit:
   Set rep = Nothing
   Set de = Nothing
   SetStatusMessageForControl edStatus, msgClearAll
   Screen.MousePointer = vbDefault
   Exit Sub

SubErrorHandler:
   Screen.MousePointer = vbDefault
   Dim msg As String
   msg = "Номер: " & Err.Number
   msg = msg + vbNewLine + "Описание: " & Err.Description

   MsgBox msg, vbExclamation, "Ошибка!", Err.HelpFile, Err.HelpContext
   GoTo SubExit
End Sub


Private Sub Form_Load()
   On Error GoTo SubErrorHandler
   Screen.MousePointer = vbHourglass
   
   edOrderByingStartDate = Date
   edOrderByingEndDate = DateAdd("d", 30, Date)
   edOrderProcessedStartDate = edOrderByingStartDate
   edOrderProcessedEndDate = edOrderByingEndDate
   
   FillFilterFaceList cbWorker
   FillOtdelList cbOtdel
   FillOrderList cbOrders

SubExit:
   Screen.MousePointer = vbDefault
   Exit Sub

SubErrorHandler:
   Screen.MousePointer = vbDefault
   Dim msg As String
   msg = "Номер: " & Err.Number
   msg = msg + vbNewLine + "Описание: " & Err.Description

   MsgBox msg, vbExclamation, "Ошибка!", Err.HelpFile, Err.HelpContext
   GoTo SubExit
End Sub

' Заполнение фильтра ответственных лиц
Function FillFilterFaceList(combo As ComboBox) As Boolean
   
   ' fill control with process faces
   FillFilterFaceList = False
   combo.Clear
   combo.AddItem "Все", 0
   combo.ItemData(combo.NewIndex) = 0
   combo.ListIndex = 0

   Dim rsPurchaseGroups As New Recordset
   rsPurchaseGroups.Open "SELECT distinct tblSPurchaseGroups.keyWorker,tblSWorkers.sName" _
      & " FROM tblSWorkers INNER JOIN (tblSPurchaseGroups INNER JOIN tblSPurchaseUnits ON tblSPurchaseGroups.keyPurchaseGroup = tblSPurchaseUnits.keyPurchaseGroup) ON tblSWorkers.keyWorker = tblSPurchaseGroups.keyWorker" _
      & " ORDER BY tblSWorkers.sName" _
      , MainDocument.DBConnection, adOpenStatic, adLockOptimistic
    
   Dim i As Integer
   i = 1
   Do While Not rsPurchaseGroups.EOF
      combo.AddItem rsPurchaseGroups!sName, i
      combo.ItemData(i) = str(rsPurchaseGroups!keyWorker)
      i = i + 1
      rsPurchaseGroups.MoveNext
   Loop
   rsPurchaseGroups.Close
   Set rsPurchaseGroups = Nothing
   
   FillFilterFaceList = True
End Function

' заполнение цехов
Private Function FillOtdelList(combo As ComboBox) As Boolean
   FillOtdelList = False
   combo.Clear
   
   Dim rst As New Recordset
   rst.Open "SELECT keyOtdel, sName " & _
      "From tblSOtdel " & _
      "Where (((tblSOtdel.sName) = ""Сборочный цех"")) Or (((tblSOtdel.sName) = ""Заготовительный цех"")) Or (((tblSOtdel.sName) = ""Механический цех"")) " & _
      "ORDER BY tblSOtdel.sName" _
      , MainDocument.DBConnection, adOpenStatic, adLockOptimistic
    
   Dim i As Integer
   i = 0
   Do While Not rst.EOF
      combo.AddItem rst!sName, i
      combo.ItemData(i) = str(rst!keyOtdel)
      i = i + 1
      rst.MoveNext
   Loop
   rst.Close
   Set rst = Nothing
   
   combo.ListIndex = 0
   FillOtdelList = True
End Function

' заполнение заказов
Private Function FillOrderList(combo As ComboBox) As Boolean
   FillOrderList = False
   combo.Clear
   
   Dim rst As New Recordset
   rst.Open "SELECT DISTINCT tblDOrders.keyOrder, '(Заказ №'+tblDOrders.sNumber+') '+tblDOrders.sName AS sName " & _
      "From tblDOrders " & _
      "ORDER BY '(Заказ №'+tblDOrders.sNumber+') '+tblDOrders.sName" _
      , MainDocument.DBConnection, adOpenStatic, adLockOptimistic
    
   Dim i As Integer
   i = 0
   Do While Not rst.EOF
      combo.AddItem rst!sName, i
      combo.ItemData(i) = str(rst!keyOrder)
      i = i + 1
      rst.MoveNext
   Loop
   rst.Close
   Set rst = Nothing
   
   If combo.ListCount > 0 Then
      combo.ListIndex = 0
   Else
      combo.ListIndex = -1
   End If
   FillOrderList = True
End Function


' создание отчета по производственным объектам
Private Sub CreateProcessedUnitsReport(nType As Long)
   On Error GoTo SubErrorHandler
   Screen.MousePointer = vbHourglass
   
   ' подготовка временной таблицы
   If Not CreateStubTable(edStatus) Then GoTo SubExit
   
   Dim sOtdel As String
   sOtdel = cbOtdel.Text
   sOtdel = Left$(sOtdel, 3)
   
   ' nOtdelType 1-заготовительный; 2-механический; 3-сборочный
   Dim nOtdelType As Long
   nOtdelType = 0
   If sOtdel = "Заг" Or sOtdel = "заг" Then nOtdelType = 1
   If sOtdel = "Мех" Or sOtdel = "мех" Then nOtdelType = 2
   If sOtdel = "Сбо" Or sOtdel = "сбо" Then nOtdelType = 3
   If nOtdelType = 0 Then
      Screen.MousePointer = vbDefault
      MsgBox "Укажите производственный цех.", vbOKOnly + vbExclamation, "Внимание!"
      GoTo SubExit
   End If
     
   SetStatusMessageForControl edStatus, msgMain, "Часть 1. Подготовка данных..."
     
   ' подготовим данные для заготовительного и механического цехов
   If nOtdelType = 1 Or nOtdelType = 2 Then
      If nOtdelType = 1 Then
         MainDocument.DBConnection.Execute _
           "INSERT INTO tblTByingReport ( keyUnit, timeStart, timeToBe, dQuantity, keyOrder, dPrice ) " & _
           "SELECT tblDProcessedUnits.keyUnit, tblDProcessedUnits.timeStart, tblDProcessedUnits.timeEnd, 1 AS Count1, tblDProcessedUnits.keyOrder, 0 " & _
           "FROM tblSUnits INNER JOIN tblDProcessedUnits ON tblSUnits.keyUnit = tblDProcessedUnits.keyUnit " & _
           "WHERE (((tblDProcessedUnits.timeEnd)>=" & FormatDate(edOrderByingStartDate) & _
           ") AND ((tblDProcessedUnits.timeEnd)<=" & FormatDate(edOrderByingEndDate) & _
           ") AND (tblSUnits.keyProcLevel=3))"
      Else
         MainDocument.DBConnection.Execute _
           "INSERT INTO tblTByingReport ( keyUnit, timeStart, timeToBe, dQuantity, keyOrder, dPrice ) " & _
           "SELECT tblDProcessedUnits.keyUnit, tblDProcessedUnits.timeStart, tblDProcessedUnits.timeEnd, 1 AS Count1, tblDProcessedUnits.keyOrder, 0 " & _
           "From tblDProcessedUnits " & _
           "WHERE (((tblDProcessedUnits.timeEnd)>=" & FormatDate(edOrderByingStartDate) & _
           ") AND ((tblDProcessedUnits.timeEnd)<=" & FormatDate(edOrderByingEndDate) & _
           "))"
      End If
         
       MainDocument.DBConnection.Execute _
         "DELETE * FROM tblTByingReport WHERE (tblTByingReport.keyUnit IN (SELECT DISTINCT tblSProcessingMethod.keyUnit " & _
         "FROM tblSProcessingMethod))"
      
      SetStatusMessageForControl edStatus, msgMain, "Часть 1. Обработка данных..."
      
      ' Определение родителя для объекта, если он единственный
      Dim rstSlaveUnits As New Recordset
      rstSlaveUnits.Open _
         "SELECT DISTINCT tblSSlaveUnits.keySubUnit, First((IIf(Len(tblSUnits.sType)>0,tblSUnits.sType+', ',''))+(IIf(Len(tblSUnits.sKind)>0,tblSUnits.sKind+', ',''))+tblSUnits.sName) AS sName " & _
         "FROM tblSUnits INNER JOIN tblSSlaveUnits ON tblSUnits.keyUnit = tblSSlaveUnits.keyUnit " & _
         "GROUP BY tblSSlaveUnits.keySubUnit " & _
         "HAVING (((Min(tblSSlaveUnits.keyUnit))<>0) AND ((Count(tblSSlaveUnits.keySubUnit))=1))", MainDocument.DBConnection, adOpenStatic, adLockOptimistic
      
      Dim arKeySlaveUnits As Variant
      Dim nSizeKeySlaveUnits As Long
      Dim mColOfSlaveUnits As New Collection
      
      arKeySlaveUnits = rstSlaveUnits.GetRows
      rstSlaveUnits.Close
      
      nSizeKeySlaveUnits = UBound(arKeySlaveUnits, 2)  ' размер массива
      Dim i As Long
      For i = 0 To nSizeKeySlaveUnits
         mColOfSlaveUnits.Add CStr(arKeySlaveUnits(1, i)), CStr(arKeySlaveUnits(0, i))
      Next i
      
      ' Определение дочернего объекта, если он состоит из единственного объекта
'      rstSlaveUnits.Open _
'         "SELECT DISTINCT tblSSlaveUnits.keyUnit, First(tblSUnits.sName+(IIf(Len(tblSUnits.sType)>0,', '+tblSUnits.sType,''))+(IIf(Len(tblSUnits.sKind)>0,', '+tblSUnits.sKind,''))) AS sName " & _
'         "FROM tblSUnits INNER JOIN tblSSlaveUnits ON tblSUnits.keyUnit = tblSSlaveUnits.keySubUnit " & _
'         "GROUP BY tblSSlaveUnits.keyUnit " & _
'         "HAVING (((Count(tblSSlaveUnits.keySubUnit))=1))", MainDocument.DBConnection, adOpenStatic, adLockOptimistic
      
      
'      arKeySlaveUnits = rstSlaveUnits.GetRows
'      rstSlaveUnits.Close
      Set rstSlaveUnits = Nothing
      
'      Dim mColOfParentUnits As New Collection
'      nSizeKeySlaveUnits = UBound(arKeySlaveUnits, 2)  ' размер массива
'      For i = 0 To nSizeKeySlaveUnits
'         mColOfParentUnits.Add CStr(arKeySlaveUnits(1, i)), CStr(arKeySlaveUnits(0, i))
'      Next i
      
      ' обработаем дату производства
      Dim rst As New Recordset
      rst.Open "tblTByingReport", MainDocument.DBConnection, adOpenStatic, adLockBatchOptimistic, adCmdTable
      Do While Not rst.EOF
         If nOtdelType = 1 Then
            rst![timeToBe] = AddDateWithWeekend(rst![timeStart], GetSecondProcessPart() - 2)
         Else
            rst![timeToBe] = AddDateWithWeekend(rst![timeToBe], -2)
            rst![timeStart] = AddDateWithWeekend(rst![timeStart], GetSecondProcessPart() - 1)
         End If
         
         On Error Resume Next
         rst![txtValue] = CStr(mColOfSlaveUnits(CStr(rst![keyUnit])))
'         rst![txtValue2] = CStr(mColOfParentUnits(CStr(rst![keyUnit])))
         On Error GoTo SubErrorHandler
         
         rst.Update
         rst.MoveNext
      Loop

      SetStatusMessageForControl edStatus, msgMain, "Часть 1. Запись данных..."
      rst.UpdateBatch
      rst.Close
      Set rst = Nothing
      
      SetStatusMessageForControl edStatus, msgMain, "Часть 2. Подготовка данных..."
   End If
     
   ' добавим в сборочный цех все узлы
   If nOtdelType = 3 Then
      MainDocument.DBConnection.Execute _
         "INSERT INTO tblTByingReport ( keyUnit, timeStart, timeToBe, dQuantity, keyOrder ) " & _
         "SELECT tblDProcessedUnits.keyUnit, tblDProcessedUnits.timeEnd, tblDProcessedUnits.timeEnd, 1 AS Count1, tblDProcessedUnits.keyOrder " & _
         "FROM tblSUnits INNER JOIN tblDProcessedUnits ON tblSUnits.keyUnit = tblDProcessedUnits.keyUnit " & _
         "WHERE (((tblSUnits.keyProcLevel)=2))"
         
      ' удалим объекты, которые есть в таблице производства
      MainDocument.DBConnection.Execute _
         "DELETE * FROM tblTByingReport " & _
         "WHERE (((tblTByingReport.keyUnit) IN (SELECT DISTINCT tblSProcessingMethod.keyUnit " & _
         "FROM tbSOperations INNER JOIN tblSProcessingMethod ON tbSOperations.keyOperation = tblSProcessingMethod.keyOperation " & _
         "WHERE tbSOperations.keyOtdel=" & cbOtdel.ItemData(2) & ")))"
   End If
   
   ' данные о объекта, входящих в производственную таблицу (не включаем узлы для заготовительного цеха)
   ' скорректируем последний день (уменьшим на единицу)
   Dim rstTemp As New Recordset
   If nOtdelType = 1 Then
      rstTemp.Open _
         "SELECT tblDProcessedUnits.keyUnit, tblDProcessedUnits.timeStart, tblDProcessedUnits.timeEnd, 1 AS Count1, tblDProcessedUnits.keyOrder " & _
         "FROM tblSUnits INNER JOIN tblDProcessedUnits ON tblSUnits.keyUnit = tblDProcessedUnits.keyUnit " & _
         "WHERE (((tblSUnits.keyProcLevel)=3) AND ((tblDProcessedUnits.keyUnit) IN (SELECT DISTINCT tblSProcessingMethod.keyUnit " & _
         "FROM tbSOperations INNER JOIN tblSProcessingMethod ON tbSOperations.keyOperation = tblSProcessingMethod.keyOperation " & _
         "WHERE tbSOperations.keyOtdel=" & cbOtdel.ItemData(cbOtdel.ListIndex) & ")))", _
         MainDocument.DBConnection, adOpenStatic, adLockOptimistic
   Else
      rstTemp.Open _
         "SELECT tblDProcessedUnits.keyUnit, tblDProcessedUnits.timeStart, tblDProcessedUnits.timeEnd, 1 AS Count1, tblDProcessedUnits.keyOrder " & _
         "FROM tblDProcessedUnits " & _
         "WHERE (((tblDProcessedUnits.keyUnit) IN (SELECT DISTINCT tblSProcessingMethod.keyUnit " & _
         "FROM tbSOperations INNER JOIN tblSProcessingMethod ON tbSOperations.keyOperation = tblSProcessingMethod.keyOperation " & _
         "WHERE tbSOperations.keyOtdel=" & cbOtdel.ItemData(cbOtdel.ListIndex) & ")))", _
          MainDocument.DBConnection, adOpenStatic, adLockOptimistic
   End If
   
   rst.Open "tblTByingReport", MainDocument.DBConnection, adOpenStatic, adLockBatchOptimistic, adCmdTable
   Do While Not rstTemp.EOF
      rst.AddNew
      rst![keyUnit] = rstTemp![keyUnit]
      rst![timeStart] = rstTemp![timeStart]
      rst![timeToBe] = AddDateWithWeekend(rstTemp![timeEnd], -2)
      rst![dQuantity] = rstTemp![Count1]
      rst![keyOrder] = rstTemp![keyOrder]
      rst.Update
      rstTemp.MoveNext
   Loop
   rst.UpdateBatch
   rst.Close
   Set rst = Nothing
   rstTemp.Close
   Set rstTemp = Nothing
   
'   If nOtdelType = 1 Then
'      MainDocument.DBConnection.Execute _
'         "INSERT INTO tblTByingReport ( keyUnit, timeStart, timeToBe, dQuantity, keyOrder ) " & _
'         "SELECT tblDProcessedUnits.keyUnit, tblDProcessedUnits.timeStart, tblDProcessedUnits.timeEnd, 1 AS Count1, tblDProcessedUnits.keyOrder " & _
'         "FROM tblSUnits INNER JOIN tblDProcessedUnits ON tblSUnits.keyUnit = tblDProcessedUnits.keyUnit " & _
'         "WHERE (((tblSUnits.keyProcLevel)=3) AND ((tblDProcessedUnits.keyUnit) IN (SELECT DISTINCT tblSProcessingMethod.keyUnit " & _
'         "FROM tbSOperations INNER JOIN tblSProcessingMethod ON tbSOperations.keyOperation = tblSProcessingMethod.keyOperation " & _
'         "WHERE tbSOperations.keyOtdel=" & cbOtdel.ItemData(cbOtdel.ListIndex) & ")))"
'   Else
'      MainDocument.DBConnection.Execute _
'         "INSERT INTO tblTByingReport ( keyUnit, timeStart, timeToBe, dQuantity, keyOrder ) " & _
'         "SELECT tblDProcessedUnits.keyUnit, tblDProcessedUnits.timeStart, tblDProcessedUnits.timeEnd, 1 AS Count1, tblDProcessedUnits.keyOrder " & _
'         "FROM tblDProcessedUnits " & _
'         "WHERE (((tblDProcessedUnits.keyUnit) IN (SELECT DISTINCT tblSProcessingMethod.keyUnit " & _
'         "FROM tbSOperations INNER JOIN tblSProcessingMethod ON tbSOperations.keyOperation = tblSProcessingMethod.keyOperation " & _
'         "WHERE tbSOperations.keyOtdel=" & cbOtdel.ItemData(cbOtdel.ListIndex) & ")))"
'   End If
   
   ' подготовка бужманого отчета
   SetStatusMessageForControl edStatus, msgMain, "Создание отчета..."
   
   MainDocument.WaitExecuteFinished
   Dim de As deIMF
   Set de = New deIMF
   de.IMF.ConnectionString = "Provider=MSDataShape.1;Persist Security Info=True;Data Source='" & MainDocument.DBName & "';Data Provider=MICROSOFT.JET.OLEDB.4.0"
   
   If nType = 1 Then
      Dim rep1 As New repProcessedUnitsByOrder
      Set rep1.DataSource = de
      rep1.Show vbModal, Me
   Else
      Dim rep2 As New repProcessedUnitsByName
      Set rep2.DataSource = de
      rep2.Show vbModal, Me
   End If
   
SubExit:
   Set rep1 = Nothing
   Set rep2 = Nothing
   Set de = Nothing
   Screen.MousePointer = vbDefault
   SetStatusMessageForControl edStatus, msgClearAll
   Exit Sub

SubErrorHandler:
   Screen.MousePointer = vbDefault
   Dim msg As String
   msg = "Номер: " & Err.Number
   msg = msg + vbNewLine + "Описание: " & Err.Description

   MsgBox msg, vbExclamation, "Ошибка!", Err.HelpFile, Err.HelpContext
   GoTo SubExit
End Sub