Обход спецификаций в заказе

Option Explicit

Dim TCS As CSDN.TCS
Dim App As CSDN.Tcs_Application

Public Sub Login()

'Создадим объект ТКС АПИ

If TCS Is Nothing Then Set TCS = CreateObject("CSDN.TCS")

'Создадим экземляр приложения (сеанс). Внимание ! создание повторного сеанса не допустимо!


If App Is Nothing Then Set App = TCS.Login 'вызывает стандартное окно аутентификации пользователя

'Set App = TCS.LoginEx("Администратор", "0")  ' Если вы сами пишите диалог ввода пользователя и пароля или просто его знаете

'Set App = TCS.LoginCurrent ' если вы хотите использовать сеанс уже запущенного ТКС

End Sub


Public Function LoadNmkSpec(CellPos As Long, StartPos As Long, NMkId As Long, VerId As Long)
Dim NmkSpec As CSDN.NmkSpecification
Dim UsedVer As CSDN.UsedNMkVersions


On Error GoTo L1
 Set NmkSpec = App.NmkSpecification(NMkId, VerId)
 If Not NmkSpec Is Nothing Then
  
  NmkSpec.First
  While Not NmkSpec.EOF
    CellPos = CellPos + 1
    ActiveWorkbook.Sheets(1).Cells(CellPos, StartPos + 1) = NmkSpec.Properties("NMK_NOTE").DisplayText
    ActiveWorkbook.Sheets(1).Cells(CellPos, StartPos + 2) = NmkSpec.Properties("NMK_NAME").DisplayText
    ActiveWorkbook.Sheets(1).Cells(CellPos, StartPos + 3) = NmkSpec.Properties("QUANTITY").DisplayText
    Set UsedVer = NmkSpec.Properties("UsedVersions").AsIDispatch
    UsedVer.First
    While Not UsedVer.EOF
      If UsedVer.UsedVersionIsSpecification And UsedVer.Properties("USED_VERSION").DisplayText <> "" Then
         CellPos = LoadNmkSpec(CellPos, StartPos + 1, NmkSpec.Properties("NMK_ID").AsInteger, UsedVer.Properties("USED_VERSION").AsInteger)
      End If
      UsedVer.Next
    Wend
    Set UsedVer = Nothing
    
    NmkSpec.Next
  Wend
  
 End If
 
 GoTo L2
L1:
 CellPos = CellPos + 1
 ActiveWorkbook.Sheets(1).Cells(CellPos, StartPos + 1) = "Ошибка при чтении спецификации!"
L2:
  Set UsedVer = Nothing
  Set NmkSpec = Nothing

  LoadNmkSpec = CellPos
End Function

Public Sub LoadSpec()

  Call Login
  
  Dim NMks As CSDN.Nomenclatures
  Dim CellPos As Long
    
  If App.NmkClasses.RunModuleForSelect("Выберите класс", False) Then
    Set NMks = App.Nomenclatures(App.NmkClasses.Properties("ID").AsInteger)
    
    If NMks.RunModuleForSelect("Выбериет номенклатуру для разузлования", False) Then
      ActiveWorkbook.Sheets(1).Select
      ActiveWorkbook.Sheets(1).Cells.Select
      Selection.ClearContents
      CellPos = 2
      CellPos = LoadNmkSpec(CellPos, 1, NMks.Properties("ID").AsInteger, -1)
      CellPos = CellPos + 1
      ActiveWorkbook.Sheets(1).Cells(CellPos, 1) = "Успешно завершено!"
    End If
    
    Set NMks = Nothing
    
  End If
End Sub

Public Function LoadNmkSpec1(CellPos As Long, StartPos As Long, NMkId As Long, VerId As Long)
Dim NmkSpec As CSDN.NmkSpecification
Dim NmkVer As CSDN.NMkVersions

On Error GoTo L1
 Set NmkSpec = App.NmkSpecification(NMkId, VerId)
 If Not NmkSpec Is Nothing Then
  
  NmkSpec.First
  While Not NmkSpec.EOF
    CellPos = CellPos + 1
    ActiveWorkbook.Sheets(1).Cells(CellPos, StartPos + 1) = NmkSpec.Properties("NMK_NOTE").DisplayText
    ActiveWorkbook.Sheets(1).Cells(CellPos, StartPos + 2) = NmkSpec.Properties("NMK_NAME").DisplayText
    ActiveWorkbook.Sheets(1).Cells(CellPos, StartPos + 3) = NmkSpec.Properties("QUANTITY").DisplayText
    Set NmkVer = App.NMkSpecificationVersions(NmkSpec.Properties("NMK_ID").AsInteger)
    If Not NmkVer Is Nothing Then
      NmkVer.First
      While Not NmkVer.EOF
        'Ищем активную
        If NmkVer.Properties("VER_STATE").DisplayText = "Активная(Утверждена)" Or NmkVer.Properties("VER_STATE").DisplayText = "Активная(Редактирование)" Then
        'Можно также было использовать If NmkVer.Properties("VER_STATE").Asinteger=0 or 1, хотя еще правильней оформить отдельное свойство для этого (удобней работать).  Наш недочет, исправим.
         CellPos = LoadNmkSpec1(CellPos, StartPos + 1, NmkSpec.Properties("NMK_ID").AsInteger, NmkVer.Properties("ID").AsInteger)
        End If
        NmkVer.Next
      Wend
    End If
    Set NmkVer = Nothing
    
    NmkSpec.Next
  Wend
  
 End If
 
 GoTo L2
L1:
 CellPos = CellPos + 1
 ActiveWorkbook.Sheets(1).Cells(CellPos, StartPos + 1) = "Ошибка при чтении спецификации!"
L2:
  Set NmkVer = Nothing
  Set NmkSpec = Nothing

  LoadNmkSpec1 = CellPos
End Function

Public Sub LoadSpec()

  Call Login
  
  Dim NMks As CSDN.Nomenclatures
  Dim CellPos As Long
    
  If App.NmkClasses.RunModuleForSelect("Выберите класс", False) Then
    Set NMks = App.Nomenclatures(App.NmkClasses.Properties("ID").AsInteger)
    
    If NMks.RunModuleForSelect("Выбериет номенклатуру для разузлования", False) Then
      ActiveWorkbook.Sheets(1).Select
      ActiveWorkbook.Sheets(1).Cells.Select
      Selection.ClearContents
      CellPos = 2
      CellPos = LoadNmkSpec1(CellPos, 1, NMks.Properties("ID").AsInteger, -1)
      CellPos = CellPos + 1
      ActiveWorkbook.Sheets(1).Cells(CellPos, 1) = "Успешно завершено!"
    End If
    
    Set NMks = Nothing
    
  End If
End Sub