VBA в помощь при разработки шаблонов ЭД

При внедрении системы DIRECTUM, все мы настраиваем шаблоны электронных документов, с автоматической подстановкой значений реквизитов из карточек. Для этих целей, конечно же, используем интеграцию DIRECTUM с MS Office («DIRECTUM\Вставить поле в текст»). Однако, попадаются такие документы, когда существующего функционала вставки значений реквизитов из карточки не хватает. Например, в тексте документа встречаются повторяющиеся фрагменты, значениями которых могут быть табличные части в карточке документа, или, например, значения «третьего уровня» «справочных» реквизитов, и т.п. В этих случаях и можно прибегнуть к помощи VBA, при разработке шаблонов.

Итак, имеем шаблон документа, настроив всё, что можно с помощью стандартных средств, переходим к созданию макроса (горячие клавиши Alt+F11), создадим процедуру updatedocument(), которую пользователь будет вызывать. Здесь есть такие особенности при разработке: в текст шаблона помещаем специальные метки (ключевые слова), вместо которых будем подставлять значения из карточек, необходимо выводить ИД документа в шаблон, по которому можно будет найти документ в системе. Пример подобной процедуры:

Sub updatedocument()
  ' поиск ИД документа
  Selection.Find.ClearFormatting
  Selection.Find.Text = "IDDOCUMENT"
  Selection.Find.Replacement.Text = ""
  Selection.Find.Forward = True
  Selection.Find.Wrap = 1
  Selection.Find.Format = False
  Selection.Find.MatchCase = False
  Selection.Find.MatchWholeWord = False
  Selection.Find.MatchWildcards = False
  Selection.Find.MatchSoundsLike = False
  Selection.Find.MatchAllWordForms = False
  Selection.Find.Execute

  If (Selection.Find.Found) Then
   With Selection
     ' выделить ид документа
     .MoveRight
     .MoveUp Unit:=wdParagraph
     .MoveDown Unit:=wdParagraph, Extend:=wdExtend
     Row = .Text
     ' удалить ид документа из окончательного документа
     .TypeParagraph
     .TypeBackspace
    
     ' ид документа
     IDDocument = Replace(Row, "IDDOCUMENT", "")
    
     ' найти учредителей в карточке организации
     .Find.Text = "FIOUCHREDITELI"
     .Find.Execute
     If (.Find.Found) Then
      ' получить объект DIRECTUM
      On Error GoTo Error1
       Set LP = CreateObject("SBLogon.LoginPoint")
       Set App = LP.GetApplication("systemcode=DIRECTUM")
       Set Doc = App.EDocumentFactory.GetObjectByID(IDDocument)
      
       ' получить организацию
       KodOrg = Doc.Requisites("Организация").Value
       If KodOrg <> "" Then
         Set RefOrg = App.ReferencesFactory.ОРГ.GetObjectByCode(KodOrg)
      
         ' получить всех учредителей в карточке организации
         Set UCH = RefOrg.DetailDataSet(3)
         While (Not UCH.EOF)
          KodUch = UCH.Requisites("PersonT3").Value
          Set RefUch = App.ReferencesFactory.ПРС.GetObjectByCode(KodUch)
          
          surname = RefUch.Requisites("Дополнение").AsString    ' Фамилия
          pname = RefUch.Requisites("Дополнение2").AsString     ' Имя
          middlename = RefUch.Requisites("Дополнение3").AsString ' Отчество
          
          ' шаблон вывода Фамилия Имя Отчество
          output = surname + " " + pname + " " + middlename
          
          ' вывести в документ
          .TypeText (output)
          .TypeParagraph
          
          ' к следующему учредителю
          UCH.Next
         Wend
         .TypeBackspace
        
         ' найти вкладчиков, они же учредители в карточке организации
         .Find.Text = "FIOVNOSYAT"
         .Find.Execute
         If (.Find.Found) Then
          ' к началу списка учредителей
          UCH.First
          ' цикл по списку учредителей
          While (Not UCH.EOF)
           KodUch = UCH.Requisites("PersonT3").Value
           Set RefUch = App.ReferencesFactory.ПРС.GetObjectByCode(KodUch)
          
           surname = RefUch.Requisites("Дополнение").AsString    ' Фамилия
           pname = RefUch.Requisites("Дополнение2").AsString     ' Имя
           middlename = RefUch.Requisites("Дополнение3").AsString ' Отчество
           imuschestvo = UCH.Requisites("СтрокаТ3").AsString     ' Имущество
           kolvo = UCH.Requisites("ЦелоеТ3_ГК").AsString       ' Количество
           kolvop = UCH.Requisites("Строка2Т3").AsString       ' Количество прописью
           cost = UCH.Requisites("ДробноеТ3_ГК").AsString       ' Стоимость
           costp = UCH.Requisites("Строка3Т3").AsString        ' Стоимость прописью
          
           ' шаблон вывода Фамилия Имя Отчество вносит имущество, принадлежащее ему на праве собственности, - Имущество - в количестве Количество (Количество прописью) штука, оцененный в Стоимость (Стоимость прописью) рублей.
           output = surname + " " + pname + " " + middlename + " вносит имущество, принадлежащее ему на праве собственности, - " + imuschestvo + " - в количестве " + kolvo + " (" + kolvop + ") штука, оцененный в " + cost + " (" + costp + ") рублей."
          
           ' вывести в документ
           .TypeText (output)
           .TypeParagraph
          
           ' к следующему вкладчику
           UCH.Next
          Wend
          .TypeBackspace
         End If
        
         ' и так далее по тексту шаблона
       End If
      GoTo Ends:
Error1:
      MsgBox ("Ошибка при подстановке")
Ends:
     End If
   End With
  End If
End Sub

А вот так это будет выглядеть у пользователя:


Выбираем макрос:


Получаем результат:


Во вложении шаблон-пример для Word-документа и для Excel-документа

VBA_Shablon_Directum.7z (425,17 Кб)