Пример работы Lotsia->VBScript->COM->MS Word

Обсуждение технических вопросов работы с системами управления базами данных (СУБД), работе с языком SQL и скриптовыми языками.
Ответить
Аватара пользователя
Александр
Активный участник
Сообщения: 1652
Зарегистрирован: 24 авг 2006, 08:06
Используемое ПО: Lotsia PDM PLUS
Откуда: 55.745578,37.665825

Пример работы Lotsia->VBScript->COM->MS Word

Сообщение Александр »

в продолжении http://www.lplm.ru/phpBB2/viewtopic.php?f=2&t=636
работаем с параметрами и таблицами Word, используем прямые запросы к БД
пример - выпуск заявки на пропуска для участников маркетингового мероприятия (формат Word)
1. Готовим шаблон Word (за неимением возможности приложить файл - все на словах)
определяем ключевые поля - придумываем им псевдонимы - и макросом превращаем их в DOCPROPERTY
выглядит так
Захват-92.gif
Захват-92.gif (4.15 КБ) 12345 просмотров
где sPeriod, sCompany, fDol и т.д. не что иное как пользовательские DOCPROPERTY, можно использовать служебные поля - Вставка/Поле, можно сделать своих сколько нужно - ограничение - значение поля принимает по моему не более 1024 символов - так что для коротких записей вполне.
Сам макрос для преобразования текста в свойство
почитать - yandex.ru = "Формирование и регистрация стандартных документов Word"
макрос

Код: Выделить всё

Sub SetProperties()
Dim strName As String
Dim strVal As String
Dim strFld As String
Dim objDp As DocumentProperties
Dim blnFound As Boolean
Dim objTest As Object
Dim intAns As Integer

strName = Trim(Selection.Text)
strVal = strName
strName = InputBox("Value = " & strVal & Chr(13) & Chr(13) _
          & "Enter Name, Please.", "Set Property", strName)
If strName <> Empty Then
    blnFound = False
    For Each objTest In ActiveDocument.CustomDocumentProperties
        If objTest.Name = strName Then blnFound = True
    Next
    If blnFound Then
        intAns = MsgBox("Name Already Exist", vbCritical)
        Exit Sub
    End If
    Set objDp = ActiveDocument.CustomDocumentProperties
    objDp.Add Name:=strName, LinkToContent:=False, _
    Type:=msoPropertyTypeString, Value:=strVal
    strFld = "DOCPROPERTY " & """" & strName & """"
    With ActiveDocument.Content.Find
        .ClearFormatting
        Do While .Execute(FindText:=strVal, Forward:=True, _
                 Format:=True) = True
            With .Parent
                .Select
                intAns = MsgBox("Replace " & """" & Selection _
                         & """" & Chr(13) & " With " _
                         & strFld, vbYesNo + vbQuestion)
                If intAns = vbYes Then
                    Selection.Fields.Add Range:=Selection.Range, _
                    Type:=wdFieldEmpty, Text:= _
                    strFld, PreserveFormatting:=False
                End If
                .StartOf Unit:=wdWord, Extend:=wdMove
                .Move Unit:=wdWord, Count:=1
            End With
        Loop
    End With
Else
    Exit Sub
End If
End Sub
Создаем сколько нужно полей.
И второе - используем таблицы, как для табличных данных - список, так и для подписей
оч. удобно

после оформления документа - удаляем макрос.
в итоге шаблон имеет нужные поля, пустые таблицы, колонтитулы - в общем все оформление

2. Работаем с шаблоном из VBScript

Код: Выделить всё

Sub Print_Access()
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
     Dim Path,WordApp, DocWrd 
     Dim sql, Arr, i , j
     Dim Check, id_aObject, sCompany, sManager, fManager,sDol, fCompany, fDol
     Dim sCompany_id, sManager_id, Filial_str 
     Dim  d_Begin_atr, d_End_atr

'прочтем данные из Лоции
     id_aObject=LsVars.GetVarValue("id_aObject")
     Check=LsVars.GetVarValue("Check")
     Path= "...Заявка на посетителей.doc" 

'прочтем данные из БД
    If DataBase.ADODB_Connected Then                                                                                       ' если подключиться удалось работаем иначе нет
      If DataBase.ADODB_RecordSet Then                                                                                      ' если удалось создать recordset тоже работаем
'прочтем данные по мероприятию
        sql = "select * from LSDBO.Ric_Get_aAttrib(" & CStr(id_aObject) & ")order by IdTypeAttr"
        rs.Open sql, cn
          d_Begin_atr = database.getDataFromRs(8, cDateTime)                                     ' d_Begin_atr
          d_End_atr = database.getDataFromRs(9, cDateTime)                                        ' d_End_atr
          fManager = database.getDataFromRs(3000000000122, cString)                  ' fManager 
          Filial_str = database.getDataFromRs(100004086200000, cString)                       ' Filial_str 
          sCompany_id = database.getDataFromRs(100004087100000, cNumeric)                   ' sCompany_id 
          sManager_id= database.getDataFromRs(100004087200000, cNumeric)                   ' sManager_id
        rs.Close

        sCompany=DataBase.GetSingleData("Select LSDBO.Ric_Get_CompanyName(" & cStr(sCompany_id) & ")")                            ' наименование принимающей компании
        sManager=DataBase.GetSingleData("Select LSDBO.Ric_Get_String_atr(" & cStr(sManager_id) & ",3000000000121)")           ' наименование контактного лица принимающей стороны
        sDol=DataBase.GetSingleData("Select LSDBO.Ric_Get_String_atr(" & cStr(sManager_id) & ",3000000000086)")                   ' должность контактного лица принимающей стороны

        i=DataBase.GetSingleData("select cid from LSDBO.Ric_Get_Filials() where name='" & Filial_str & "'")                                        ' id КОМПАНИИ филиала инициирующей стороны 
        fCompany=DataBase.GetSingleData("Select LSDBO.Ric_Get_CompanyName(" & cStr(i) & ")")                                                 ' наименование инициирующей компании 
        i=DataBase.GetSingleData("select sid from LSDBO.Ric_Get_Filials() where name='" & Filial_str & "'")                                         ' id ПРЕДСТАВИЛЬСТВА филиала инициирующей стороны 
        i=DataBase.GetSingleData("select id from lsdbo.ric_get_chUsers(" & cStr(i) & ") where ffio='" & fManager & "'")                         ' id Менеджера ответственного за Мероприятие
        fDol=DataBase.GetSingleData("Select LSDBO.Ric_Get_String_atr(" & cStr(i) & ",3000000000086)")                                         ' должность контактного лица инициирующей стороны
     
'прочтем данные по участникам докладчикам
        select case check
          case 1                               ' докладчики и участники
            sql = "SELECT rw.description, vv1.value, vv2.value FROM lsdbo.object_reference rw left join lsdbo.object_type tw on rw.type_id=tw.id left join lsdbo.attrib_value av1 on rw.id=av1.object_id and av1.attrib_id=3000000000086 left join lsdbo.value_string vv1 on av1.value_id=vv1.id and av1.attrib_id=3000000000086 left join lsdbo.attrib_value av2 on rw.id=av2.object_id and av2.attrib_id=100004068400000 left join lsdbo.value_string vv2 on av2.value_id=vv2.id and av2.attrib_id=100004068400000 where rw.id in (select id from LSDBO.Ric_Get_objChild("+cStr(id_aObject)+",'Стки,Стк') union all select id from LSDBO.Ric_Get_objChild("+cStr(id_aObject)+",'Lsts,Lst')) order by rw.description"
          case 2                               ' докладчики 
            sql = "SELECT ..."
          case 0                               ' участники
            sql = "SELECT ..."
        end select  
        rs.Open sql, cn
        Arr = rs.GetRows '(Rows, Start, Fields)
        rs.Close
        Set cn = Nothing       'убить объект соединения с базой
      End if
    End If

'сформируем Word
    set WordApp=CreateObject("Word.Application")
    set DocWrd= WordApp.Documents.Open(Path) 
'    WordApp.Visible=True                                                                                           'сделать Word видимым
    With DocWrd                                                                                                       'заполним таблицу 1 данными
      If UBound(Arr, 2) > 0 Then                                                                                   'расширим таблицу если нужно
        .Tables(1).Rows(2).Select
         WordApp.Selection.InsertRowsBelow (UBound(Arr, 2) )
      End If

      For i = LBound(Arr, 2) To UBound(Arr, 2) 
        .Tables(1).Cell(i + 2, 1).Range.InsertAfter i + 1
        For j = 0 To 2
          .Tables(1).Cell(i + 2, j + 2).Range.Text = Arr(j, i) 'InsertAfter Arr(j, i)
        Next
      Next

      .CustomDocumentProperties("sType").Value = ""                                           ' тип семинара
      .CustomDocumentProperties("sName").Value = ""                                          ' наименование семинара  
      .CustomDocumentProperties("sPeriod").Value = "с " & FormatDateTime(d_Begin_atr,4) & " (" & FormatDateTime(d_Begin_atr,2) & ")" & " по " &  FormatDateTime(d_End_atr,4) & " (" & FormatDateTime(d_End_atr,2) & ")" & " г."           ' период проведения семинара

      .CustomDocumentProperties("sCompany").Value = sCompany                       ' компания где проводится семинар
      .CustomDocumentProperties("sManager").Value = sManager                         ' представитель компании где проводится семинар
      .CustomDocumentProperties("sDol").Value = "Руководителю службы безопасности"                                              ' должность представителя компании где проводится семинар

      .CustomDocumentProperties("fCompany").Value = fCompany                                      ' компания проводящая семинар
      .CustomDocumentProperties("fManager").Value = RegExp.GetShortFIO(fManager)             ' представитель компании проводящей семинар
      .CustomDocumentProperties("fDol").Value = fDol                                                ' должность представителя компании проводящей семинар
    
      .Fields.Update
   
    End With
    Erase Arr

    WordApp.Visible=True                                                                                           'сделать Word видимым

    'отключимся от Word (очистим память) (убъем обекты)
    if Not DocWrd Is Nothing Then Set DocWrd= Nothing
    if Not WordApp Is Nothing Then Set WordApp = Nothing 
End Sub
получаем готовый документ
Захват-93.gif
Захват-93.gif (8.46 КБ) 12345 просмотров
Если нужно вставлять большие куски текста, формировать форматированные списки и т.д. - используем другие медоды VBA Word документа - ищем нужное место в тексте - вставляем - форматируем.

Интересных эффектов можно добиться в комбинации использования COM Excel+Word где на основе данных собранных из БД формируется файл Excel настроенный на вычисление некоторых результатов и формирующий некоторые итоговые таблицы (все макросы запускаются удаленно из VBScript) после чего данные из этих таблиц просто вставляются в Word а Excel убивается...
в общем все что угодно, на сколько хватает фантазии.

ps
имена таблиц шаблона - можно посмотреть при отладке скрипта например из VBA Excel

Софт - RicCRM<<LotsiaPDM(4.40)<<MsSQL(5/8)
Уровень администрирования - Альтернативный

Аватара пользователя
Александр
Активный участник
Сообщения: 1652
Зарегистрирован: 24 авг 2006, 08:06
Используемое ПО: Lotsia PDM PLUS
Откуда: 55.745578,37.665825

Re: Пример работы Lotsia->VBScript->COM->MS Word

Сообщение Александр »

в самом общем смысле подход к получению Word документов следующий
1. Получить id базового объекта из БД - можно из Лоции, можно напрямую из БД через внешнее приложение через ADO
2. Создать шаблон Word с избыточными пользовательскими DOCPROPERTY и таблицами
3. Растиражировать готовые шаблоны и отредактировать/переименовать их под конкретные формы документов (файлы уже чистые - без макросов, можно отдавать рыбы заказчикам)
4. Скриптом через ADO прочитать данные из БД
5. Любым приложением имеющим COM обработать данные - имеется в виду вычисления, у нас все вычисления в Excel (формул пока хватает, если не будет - прицепимся еще к чему нибудь)
6. Все полученные, сортированные, преобразованные (например сумма прописью, склонение ФИО и т.д.) данные просто вставляем в Word

для примера - комплект из 3х документов Word (~ 10 свойств + пара таблиц ~10x10) с промежуточными вычислениями в Excel занимает 15~30 сек и это с импортом в эл. архив и открытием документов из него (все полностью на автомате - по ОДНОЙ кнопке)

ps
можно например создать внешнее, самое примитивное, на любом языке, приложение - с поиском объектов в БД и выпуском стандартных документов компании напрямую из БД - просто и со вкусом, без захвата лицензий - например для Секретарей... ну и т.д.

Софт - RicCRM<<LotsiaPDM(4.40)<<MsSQL(5/8)
Уровень администрирования - Альтернативный

Ответить