Демонстрация работы с SLS-Active Склад из Word

'Функция для распечатки позиций прайс-листа
Sub PrintPos(GAdr, Pos, Title)
Dim Sel
       'отберем карточки товаров из группы с адресом GAdr
       Set Sel = AxSession.SelectData("Rec_cards", GAdr, 0)
       'перейдем карточке с номером позиции Pos
       Sel.Position = Pos
       First = True
       'цикл по всем отобранным карточкам
       While Not Sel.EOF
                 If Sel.GetFieldAsInteger("cardtyp", 0) = 1 Then
                 'стоим на записи подгруппы, нужно распечатать карточки и из нее
                       'сохраним текущие значения параметров
                       'и сформируем параметры для вызова рекурсии
                       iGAdr = Sel.Address               
                       iPos = 0
                       curPos = Sel.Position
                       'сформируем заголовок подгруппы для печати в прайс-листе
                       iTitle = Title + " *** " + Sel.GetFieldAsString("ntovar", 0)
                       'освободим список записей, чтобы не заниметь
                       'лишнюю память во время рекурсии
                       Set Sel = Nothing
                       'вызовем рекурсию
                       Call PrintPos(iGAdr, iPos, iTitle)
                       'восстановим список записей после прохождения рекурсии
                       Set Sel = AxSession.SelectData("Rec_cards", GAdr, 0)
                       Sel.Position = curPos
                 Else
                 'стоим не записи карточки товара
                 'надо вывести строку прайс-листа
                      If First = True Then
                      'это первая карточка в подгруппе
                      'надо вывести заголовок самой подгруппы
                             Table1.Rows.Add (Table1.Rows(H))
                             Table1.Rows(H).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
                             Table1.Rows(H).Range.Font.Bold = True
                             Table1.Rows(H).Cells.Merge
                             Table1.Cell(H, 1).Range.InsertAfter (Title)
                             H = H + 1
                             First = False
                      End If
                      Table1.Rows.Add (Table1.Rows(H))
                      Table1.Cell(H, 1).Range.InsertAfter (PosNum)
                      PosNum = PosNum + 1
                      'выведем данные
                      Table1.Cell(H, 2).Range.InsertAfter (Sel.GetFieldAsString("ntovar", 0))
                      Table1.Cell(H, 3).Range.InsertAfter (Sel.GetFieldAsString("nomnum", 0))
                      Table1.Cell(H, 4).Range.InsertAfter (Sel.GetFieldAsString("ediz", 0))
                      Table1.Cell(H, 5).Split NumColumns:=PriceNum
                      j = 5
                      'выведем цены
                      For i = 1 To 5
                            If PList.NotEmpty(i) Then
                                   Table1.Cell(H, j).Range.InsertAfter (PList.CountGoodsPrice(Sel.Address, i, 10))
                                    j = j + 1
                             End If
                      Next
                      H = H + 1
                 End If
                 'перейдем к следующей записи
                 Sel.Next
       Wend
       'уничтожим ссылку на интерфейс и освободим память
       Set Sel = Nothing
End Sub

Sub PrintPriceList()
'
'макрос для печати прайс-листа

On Error Resume Next

    PriceListNom = InputBox("Введите номер пайс-листа:", "Номер прайс-листа", 3)
    GroupAdr = InputBox("Введите адрес группы товаров:", "Адрес группы", 71228)

    FlgOK = False
    'получим указатель на основной интерфейс пакета SLS-ActiveСклад
    Set AxLoader = CreateObject("SLSSklad.AxLoader")
    If Err.Number = 0 Then
    'подключимся к базе данных
    AxLoader.OpenDatabase ("c:\skladdbx\base.dbx")
         If Err.Number = 0 Then
             WSFlag = True
             'получим указатель на интерфейс AxSklad
             'и попробуем авторизовать пользователя
             Set AxSklad = AxLoader.AxSklad
             If AxSklad.Login("Login", "Password", "") Then
                   'получим указатель на интерфейс рабочего сеанса
                   Set AxSession = AxSklad.AxSession
                   'отберем записи прайс-листов
                   Set SelPriceLists = AxSession.SelectData("Rec_Pricel", 0, 0)
                   'попробуем найти прайс-лист с номером, указанным пользователем
                   If SelPriceLists.GetPriceListByNom(PriceListNom) Then
                         Set PList = SelPriceLists.GetPriceList
                         If Err.Number <> 0 Then
                                MsgBox (Err.Description)
                         Else
                                FlgOK = True
                         End If
                   Else
                         MsgBox ("Нет прайс-листа с таким номером!")
                   End If
                   If FlgOK Then
                         'попробуем отобрать записи из группы товаров
                         'с указанным пользователем адресом
                         Set SelCards = AxSession.SelectData("REC_CARDS", GroupAdr, 0)
                         If Err.Number <> 0 Then
                               FlgOK = False
                               MsgBox ("Нет группы товаров с указанным адресом!")
                         End If
                   End If
             Else
                   MsgBox ("Ошибка при авторизации пользователя!")
             End If
       Else
             MsgBox ("Не удалось подключиться к базе данных!")
             WSFlag = False
       End If
   Else 
       MsgBox ("Не удалось создать AxLoader!")
   End If

   If FlgOK Then
       Dim TopGrSel
       'получим название группы товаров
       If SelCards.GetFieldAsInteger("adrgrp", 0) = 0 Then
       'это группа товаров верхнего уровня
            Set TopGrSel = AxSession.SelectData("Rec_Cards", 0, 0)
            TopGrSel.Address = GroupAdr
            TopGrName = TopGrSel.GetFieldAsString("name", 0)
            Set TopGrSel = Nothing
       Else
       'это группа товаров второго или ниже уровня
            Set TopGrSel = AxSession.SelectData("Rec_Cards", -1, 0)
            TopGrSel.Address = GroupAdr
            TopGrName = TopGrSel.GetFieldAsString("ntovar", 0)
            Set TopGrSel = Nothing
       End If
       Set EndHeader = Selection.Paragraphs.Add
       Set nOrg = Selection.Paragraphs.Add(EndHeader.Range)
       'получим название организации из глобальных параметров системы SLS-Склад
       Dim G_Param
       Set G_Param = AxSession.SelectData("G1_param", 0, 0)
       nOrg.Range.InsertBefore G_Param.GetFieldAsString("Nameshort", 0)
       Set G_Param = Nothing
       'красиво все оформим
       nOrg.Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
       nOrg.Range.Font.Size = 10
       nOrg.Range.Font.Bold = True
       Set nPrice = Selection.Paragraphs.Add(EndHeader.Range)
       'выведем название прайс-листа
       nPrice.Range.InsertBefore SelPriceLists.GetFieldAsString("printname", 0)
       nPrice.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
       nPrice.Range.Font.Size = 16
       nPrice.Range.Font.Bold = True
       Set nGr = Selection.Paragraphs.Add(EndHeader.Range)
       nGr.Range.InsertBefore TopGrName
       nGr.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
       nGr.Range.Font.Size = 18
       nGr.Range.Font.Bold = True
       Set nPr = Selection.Paragraphs.Add(EndHeader.Range)
       'выведем комментарии к прайс-листу
       nPr.Range.InsertBefore SelPriceLists.GetFieldAsString("poisn", 0)
       nPr.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
       nPr.Range.Font.Size = 10
       Set Table1 = ActiveDocument.Tables.Add(Range:=EndHeader.Range, NumRows:=2, NumColumns _
:=5, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitContent)
       Set LastRow = Table1.Rows(2)
       Table1.AutoFormat Format:=wdTableFormatGrid1, ApplyBorders:= _
True, ApplyShading:=False, ApplyFont:=False, ApplyColor:=False, _
ApplyHeadingRows:=True, ApplyLastRow:=False, ApplyFirstColumn:=False, _
ApplyLastColumn:=False, AutoFit:=True
       Table1.Range.Font.Size = 10
       Table1.Rows.Add (LastRow)
       'озаглавим столбцы
       Table1.Cell(1, 1).Range.InsertAfter ("№ п/п")
       Table1.Cell(1, 2).Range.InsertAfter ("Наименование товара")
       Table1.Cell(1, 3).Range.InsertAfter ("Номенклатурный номер")
       Table1.Cell(1, 4).Range.InsertAfter ("Ед. изм.")
       Table1.Cell(1, 5).Range.InsertAfter ("Цены на " + CStr(Date))
       Table1.Rows(1).Cells.VerticalAlignment = wdAlignVerticalCenter
       Table1.Rows(2).Cells.VerticalAlignment = wdAlignVerticalCenter
       Table1.Rows(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
       Table1.Rows(2).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
       PriceNum = 0
       'посмотрим сколько цен в этом прайс-листе
       For i = 1 To 5
             If PList.NotEmpty(i) Then
                PriceNum = PriceNum + 1
             End If
       Next
       Table1.Cell(2, 5).Split NumColumns:=PriceNum
       j = 5
       'выведем названия цен и название валюты цены
       For i = 1 To 5
             If PList.NotEmpty(i) Then
                   Table1.Cell(2, j).Range.InsertAfter (PList.GetPriceField(i, "fname") + " " + PList.GetPriceField(i, "iUSD"))
                   j = j + 1
             End If
       Next
       PosNum = 1
       H = 3
       'вызовем функцию для печати позиций прайс-листа
       Call PrintPos(GroupAdr, 0, TopGrName)
       Table1.Rows(H).Delete
       Table1.Cell(1, 1).Merge (Table1.Cell(2, 1))
       Table1.Cell(1, 2).Merge (Table1.Cell(2, 1))
       Table1.Cell(1, 3).Merge (Table1.Cell(2, 1))
       Table1.Cell(1, 4).Merge (Table1.Cell(2, 1))
  End If

  'уничтожим указатели на интерфейсы и освободим память
  Set PList = Nothing
  Set PriceLists = Nothing
  Set SelCards = Nothing 
  Set AxSession = Nothing 
  Set AxSklad = Nothing
  'вызывать метод для закрытия подключения к базе надо,
  'только если оно было получено
  if WSFlag then
      AxLoader.CloseWorkSession
  end if
  Set AxLoader = Nothing
End Sub