Sub FormMacro_PspCalcDoc3(TCSActiveModule)                         

'Создание расчетного документа из текущей ПСп

'для выделенных позиций

Dim CalcDocs  'объект "Расчетные документы" 

Dim Order     'объект "Заказы"  

Dim PspSpecs  'объект "Производственные спецификации"

Dim CalcDocPsp 'ссылка в ПСп на рассчетный документ 

Dim CalcDoc   'экземпляр расчетного документа

Dim CalcDocSpc 'его спецификация

Dim DocNumber 'номер расчетного документа

Dim DocName   'наименование расчетного документа

Dim DocDate   'дата расчетного документа

Dim DocRem    'комментарий к расчетному документу

Dim DocTypeID 'идентификатор расчетного документа

Dim CehaID    'идентификатор подразделения  

Dim CounteragentID'идентификатор контрагента

Dim ShowDialog'режим окна диалога: 0-не показывать, 1-со всеми закладками, 2-только "Основные"

Dim DialogCaption 'заголовок окна диалога

Dim BM        'текущая позиция курсора

Dim pbStr     'прогресбар

Dim I         'служебная переменная

Dim PSpID     'идентификатор производственной спецификации

    If TCSApp.Inventory.CalculateDocumentTypes.RunModuleForSelect("Выберите тип расчетного документа", False) Then 'Выбор типа расчетного документа

        If TCSApp.PlantDepartments.RunModuleForSelect("Выберите цех/участок", False) Then  'Выбор подразделения, где будет формироваться документ

                                                                                           '

            Set CalcDocs = TCSApp.Inventory.CalculateDocuments                             'объект "Расчетные документы"

                                                                                           '          

            DocNumber = ""                                                                 'Номер документа (будет

            DocName="Документ для заказа"                                                  'Наименование документа

            Set Order = TCSApp.Manufacturing.Orders                                        'Взять заказы

            If Order.Locate("ID",TCSActiveModule.Properties( "OrderId" ).Value,0) Then     'Найти в них заказ, к которому относится ПСп

                DocName=DocName & " " &  Order.Properties( "NAME" ).Value                  'c указанием заказа

            End If    

            Set Order = Nothing                                                             'Освободить "Заказы" 

            DocDate = Date()                                                               'Дата сздания

            DocRem = "На основании ПСп "&  TCSActiveModule.Properties( "NOTE" ).Value'Комментарий к документу 

            DocTypeID = TCSApp.Inventory.CalculateDocumentTypes.Properties("ID").AsInteger 'Тип документа 

            CehaID = TCSApp.PlantDepartments.Properties("ID").AsInteger                    'Подразделение

            CounteragentID=0                                                               'Пока не указывать контрагента

            ShowDialog=0                                                                   'При добавлении не показывать закладку "Основные" 

            If TCSApp.Inventory.CalculateDocumentTypes.Properties("COUNTERAGENT_NEED").AsBoolean Then 'Если нужно указывать контрагента, то

            ShowDialog=2                                                                   'При добавлении показать закладку "Основные"

            DialogCaption = "Укажите контрагента"                                          'Показать наименование окна

            End If

            PSpID=TCSActiveModule.Properties("ID").AsInteger               'Найти идентификатор производственной спецификации

            CalcDoc = CalcDocs.AddCalculateDocument(DocNumber,DocName,DocDate,DocRem,DocTypeID,CehaID,CounteragentID,PSpID,ShowDialog,DialogCaption)'Создать документ

          If CalcDoc <> -1 Then                                            'Если документ успешно создался

            Set CalcDocSpc = CalcDocs.Properties("CalculateDocumentSpecification").AsIDispatch'Спецификация

         pbStr = CSDN_VIS_Library.constProgressBarStr                      'Взять строку прогрессбара

         BM = TCSActiveModule.GetBookmark                                  'Запомнить полжение курсора   

                                                                           '

         Set PspSpecs = TCSActiveModule.ChildModules.ModuleByName( "OrderStruct").AsIDispatch'Взять спецификацию

        If PspSpecs.RunModuleForSelect("Выберите записи", True)  Then      'Если есть выделенные записи

           For I = 0 To PspSpecs.SelectedRowsCount - 1                     'Перебираем выделенные записи сп

                pbStr = CSDN_VIS_Library.ShowProgressBar(pbStr)            'Двигаем прогрессбар

                                                                           '

                  If PspSpecs.GotoSelectedRow(I) Then                      'Позиционирование на очередную выделенную запись                                                                           ' 

                    If CalcDocSpc.Locate("NMK_ID", PspSpecs.Properties("NMK_ID").Value, 0) Then'Если такая номенклатура уже добалена 

                       CalcDocSpc.Edit                                                         'Берем ее на редактирование и складываем количество

                       CalcDocSpc.Properties("QUANTITY").Value = CalcDocSpc.Properties("QUANTITY").Value + PspSpecs.Properties("N_ORDTREE_QUAN").Value

                    Else                                                                       'Если такой номенклатуры еще нет

                       CalcDocSpc.CreateNew                                                    'Создаем новую запись

                       CalcDocSpc.Properties("NMK_ID").Value = PspSpecs.Properties("NMK_ID").Value          'ID Номенклатуры

                       CalcDocSpc.Properties("QUANTITY").Value = PspSpecs.Properties("N_ORDTREE_QUAN").Value'Количество

                       CalcDocSpc.Properties("COEFF").Value = PspSpecs.Properties("N_ORDTREE_COEFF").Value  'Коэффициент пересчета

                       CalcDocSpc.Properties("MESUR_ID").Value = PspSpecs.Properties("MESUR_ID").Value      'ID Единицы измерения

                    End If

                    On Error Resume Next                           'В случае ошибки подолжить цикл

                    CalcDocSpc.SaveChanges                         'Сохраним расчетный документ, и если произошла

                    CalcDocSpc.CancelChanges                       'ошибка, отменим все изменения  

                   End If                                          '

           Next                                                    'Конец цикла по спецификации ПСп 

            Call TCSApp.HideProgressMessage                        'Выключить прогрессбар

            Call TCSActiveModule.GotoBookmark(BM)                  'Вернуть курсор в исходное положение

            CalcDocs.EditAction.Execute                            'Дать документ для ручного редактирования 

          Else                                                     'Если в спецификаци нет выделенных записей

            Call TCSApp.HideProgressMessage                        'Выключить прогрессбар

            Call TCSActiveModule.GotoBookmark(BM)                  'Вернуть курсор в исходное положение

            Set CalcDocs = Nothing                                 'Освободить "Расчетные документы"   

            Call TCSApp.ShowMessageBox("Сообщение", "Выделите записи в спецификации!")

          End If    

          Else                                                     'Если документ создать не удалось

            Call TCSApp.ShowErrorMessage("Документ не создан!")    'То вывести сообщение об ошибке

          End If                                                   '

            Set CalcDocSpc=Nothing                                 'Освободить "Спецификацию"

            Set CalcDocs = Nothing                                 'Освободить "Расчетные документы"

        End If                                                     'Если выбран цех/участок

    End If                                                         'Если выбран тип расчетного документа

End Sub