maksvlad
Форумчанин
 
Offline
Пол: 
Расположение: Иркутск
Сообщений: 158
|
Предыдущий заголовок темы "Нужен макрос передачи данных из выделенной строки Calc в документ Writer" Здравствуйте, уважаемые форумчане!
Не знаю с какой стороны подойти к такой задачке: Есть таблица в ods, данные из которой используются для заполнения полей в документе odt (а-ля "Рассылка писем") В настоящий момент используется не слишком удобная последовательность в работе: Заполнить данные в таблице ods -> Открыть документ odt (Ручное Управление (РУ)) -> выбрать строку с данными в источнике данных (РУ) -> пустить на печать (РУ) -> сохранить сформированный документ (с данными в полях) (РУ) -> открыть сформированный документ для обработки напильником (РУ)
Желаемый результат: Заполнить данные в таблице ods -> выбрать в таблице строку (строки) с данными -> сформировать документ odt с заполненными полями (Железный Механизм (ЖМ))-> сохранить документ в указанном месте (ЖМ) -> открыть сформированный документ odt для обработки напильником (ЖМ)
Подскажите, люди добрые, куда копать?
|
|
« Последнее редактирование: 28 Апрель 2018, 13:06 от maksvlad »
|
Записан
|
|
|
|
|
maksvlad
Форумчанин
 
Offline
Пол: 
Расположение: Иркутск
Сообщений: 158
|
Так?
Спасибо огромное за пример! Последовательность отрабатывает как описано  Щас только разберусь как начинку из закладок на поля слияния базы данных перевести и можно будет пользовать  ))
|
|
« Последнее редактирование: 24 Апрель 2018, 01:09 от maksvlad »
|
Записан
|
|
|
|
maksvlad
Форумчанин
 
Offline
Пол: 
Расположение: Иркутск
Сообщений: 158
|
Чуть переделал пример, что благодушно предоставил Bigor (за что ему еще раз БОЛЬШОЕ спасибо!)
Что у меня получилось: отрабатывается вызов шаблона и формирование рассылки писем (MailMerge) с полями с нужными данными
Что не получилось: не получается отфильтровать источник записей по строке, выделенной в ods файле. Для фильтра использовал поле А1. При выполнении скрипта формируются файлы по всем строкам с данными, которые есть в файле ods
N.B. Для работы скрипта надо зарегистрировать базу данных "Test_fild_1", предоставляющую доступ к файлу Test_fild_1.ods
|
|
|
Записан
|
|
|
|
Bigor
|
Мысли: 1. Если нужны поля, то поискать решения по заполнению их макросом без использования рассылки 2. Если нужна рассылка, но не получается выбрать нужное запросом, макросом копируем нужные данные на второй лист и на него натравливаем рассылку
|
|
|
Записан
|
|
|
|
maksvlad
Форумчанин
 
Offline
Пол: 
Расположение: Иркутск
Сообщений: 158
|
Мысли: 1. Если нужны поля, то поискать решения по заполнению их макросом без использования рассылки
Мне предложенное решение с закладками понравилось. Минус для текущей ситуации в том, что все становится завязанным на макрос и все связки столбцов и закладок надо прописывать в макрос. Сейчас несколько таблиц-источников (10-15 столбцов) и около десятка шаблонов, в каждом из которых одно поле из таблицы может использоваться несколько раз в разных местах. Перелопачивать времени нет. Тем более, что просится давно другое решение. Но покаиспользуется этот костыль. Рассылка - это не самоцель. Это механизм, который уже работает с минимальными телодвижениями в области макросо и скриптописания 2. Если нужна рассылка, но не получается выбрать нужное запросом, макросом копируем нужные данные на второй лист и на него натравливаем рассылку
Вот за это спасибо. Вот это будет проще всего. Тем более, что несколько лет назад так и делалось... Только руками. Пока серфил по просторам ЛОО и ООо форумов, читал предложение на привязку не к таблице, а к запросу. Правда за пять минут ковыряния палочкой результата такое решение не дало. Точнее вообще не заработало. А так ещё один вариант
|
|
« Последнее редактирование: 26 Апрель 2018, 00:37 от maksvlad »
|
Записан
|
|
|
|
maksvlad
Форумчанин
 
Offline
Пол: 
Расположение: Иркутск
Сообщений: 158
|
Продолжаю изыскания... Что получилось: 1. Первая строка текущего листа и выделенная строка копируются в лист Merge 2. Запускается слияние. выдается файл с нужными данными в полях
Что не работает. Результат можно получить только один раз после первого запуска скрипта. Последующие вызовы скрипта приводят к тому, что формируются файлы с данными, выбранными при первом запуске. Как я полагаю, база данных предоставляющая доступ к таблице блокируется Writer, что требует перезапуска LO...
Вопрос, как снять блокировку?
N.B. Для работы скрипта надо зарегистрировать базу данных "Test_fild_10", предоставляющую доступ к файлу Test_fild_1.ods
|
|
|
Записан
|
|
|
|
Bigor
|
Пробуй Почистил немного, и добавил отключение от БД, хотя сомневаюсь, что там нужно и подключение
|
|
|
Записан
|
|
|
|
maksvlad
Форумчанин
 
Offline
Пол: 
Расположение: Иркутск
Сообщений: 158
|
Пробуй Почистил немного, и добавил отключение от БД, хотя сомневаюсь, что там нужно и подключение Спасибо за участие. Честно говоря, я не понял, где подключение к БД (ну и отключение) в файле был этот скрипт REM ***** BASIC *****
Sub Test1
oRangeS = ThisComponent.getCurrentSelection() aRangeS = oRangeS.getDataArray() 'Xray oRangeS if Ubound(aRangeS(0))<3 then msgbox("Диапазон выбран неверно") else sPath=convertToURL(replace(convertFromURL(ThisComponent.URL),ThisComponent.Title,""))
for i = 0 to UBound(aRangeS) Templ = StarDesktop.loadComponentFromUrl(sPath & "Templ1.ott","_blank",0,dimArray())
oBookMark = Templ.getBookmarks().getByName("FIO") oBookMark.getAnchor.setString(aRangeS(i)(1)) oBookMark = Templ.getBookmarks().getByName("Adr") oBookMark.getAnchor.setString(aRangeS(i)(2)) oBookMark = Templ.getBookmarks().getByName("Tema") oBookMark.getAnchor.setString(aRangeS(i)(3))
Templ.storeAsURL(sPath & "Doc_" & i & ".odt" ,dimArray())
next end if
End sub
У меня получилось отключение. Добавил oConnection.dispose() и оно все стало отпускать. Теперь надо зачистить от мусора и добавить удобностей. Кстати, а как можно выделить всю строку по ячейке, где находится курсор? UPD добавил отключение от БД, хотя сомневаюсь, что там нужно и подключение Проверил, действительно, MailMerge работает из без подключения к БД Заработало в таком виде sPath=convertToURL(replace(convertFromURL(ThisComponent.URL),ThisComponent.Title,"")) ''' MAIL MERGE ''' oMailMerge = CreateUnoService("com.sun.star.text.MailMerge") With oMailMerge .DocumentURL = ConvertToURL(sPath & "Templ2.odt") .DataSourceName = "Test_fild_10" .CommandType = com.sun.star.sdb.CommandType.TABLE .Command = "Merge" .OutputType =com.sun.star.text.MailMergeType.FILE .OutputURL=OutputURL 'when output type is FILE .SinglePrintJobs=False .execute(Array()) End With
|
|
« Последнее редактирование: 28 Апрель 2018, 04:53 от maksvlad »
|
Записан
|
|
|
|
Bigor
|
Действительно, битый файл старый файл загрузился  вот что там должно было быть Sub test1
oSlcRange = ThisComponent.getCurrentSelection() 'Получаем Выделенное
arrRangeData = oSlcRange.getDataArray()
if ubound(arrRangeData(0))=3 Then
oMerge = ThisComponent.Sheets.getByName("Merge") oRange=oMerge.getCellRangeByPosition(0,1,3,ubound(arrRangeData)+1) oRange.setDataArray(arrRangeData) ThisComponent.store
sPath=convertToURL(replace(convertFromURL(ThisComponent.URL),ThisComponent.Title,"")) 'for i = 0 to UBound(aRangeS) 'MsgBox (aRangeS(i)(0)) Templ = StarDesktop.loadComponentFromUrl(sPath & "Templ2.odt","_blank",0,dimArray())
''' MAIL MERGE ''' oDocSettings = Templ.createInstance("com.sun.star.text.DocumentSettings") oDBSourceName = oDocSettings.CurrentDatabaseDataSource 'MsgBox oDBSourceName 'Create a new database context and connection from the existing file oDBContext = CreateUnoService("com.sun.star.sdb.DatabaseContext") oDBSource = oDBContext.GetByName(oDBSourceName) oConnection = oDBSource.GetConnection("","") oConnection.Close oConnection.dispose() 'Now set up a new MailMerge using the settings extracted from that doc oMailMerge = CreateUnoService("com.sun.star.text.MailMerge") With oMailMerge .DocumentURL = ConvertToURL(sPath & "Templ2.odt") ' .Filter = sqlQuery 'Условие без 'Where' .DataSourceName = "Test_fild_10" .CommandType = com.sun.star.sdb.CommandType.TABLE .Command = "Merge" ' .CommandType = 1 '1 = predefined query, 2 SQL ' .Command = "sqlQuery" 'query name .OutputType =com.sun.star.text.MailMergeType.FILE .OutputURL=OutputURL 'when output type is FILE .SinglePrintJobs=False '.SaveAsSingleFile=True .execute(Array()) .dispose() 'oDoc.close(true) ' Stardesktop.terminate() End With
oRange.clearContents(_ com.sun.star.sheet.CellFlags.VALUE OR _ com.sun.star.sheet.CellFlags.DATETIME OR _ com.sun.star.sheet.CellFlags.STRING) Else msgbox "Проверьте выделение!" End If
End Sub
Почистил, собрал все в одну процедуру, проверку выделения добавил, лист merge чищу после отработки итп Кстати, а как можно выделить всю строку по ячейке, где находится курсор?
Щелкни на номере строки, только зачем тебе вся строка в ней 1024 ячейки? Можно получить диапазон из одной (нескольких вертикальных) ячеек, узнать номер первой последней строки, и сформировать новый диапазон добавив адреса нужных столбцов
|
|
« Последнее редактирование: 28 Апрель 2018, 07:19 от Bigor »
|
Записан
|
|
|
|
maksvlad
Форумчанин
 
Offline
Пол: 
Расположение: Иркутск
Сообщений: 158
|
Щелкни на номере строки, только зачем тебе вся строка в ней 1024 ячейки? Можно получить диапазон из одной (нескольких вертикальных) ячеек, узнать номер первой последней строки, и сформировать новый диапазон добавив адреса нужных столбцов В ручном режиме - это понятно как выделяется  Вопрос касался, как средствами Бейсика это сделать. Вся строка нужна потому, что макрос планируется использовать в нескольких таблицах, в которых количество и наименования столбцов различно. Поэтому и использовал решения с вариантами а-ля "выбрать все". Но, если подумать, на практике больше 50 полей (столбцов) для слияния не было. Если диапазон выборки ограничить 128 столбцами, то должно хватить за глаза.
|
|
|
Записан
|
|
|
|
Bigor
|
Так я про Бейсик и писал  Смотри, правда не проверял, Sub test1
oSlcRange = ThisComponent.getCurrentSelection() 'Получаем Выделенное iFirstRow = oSlcRange.startRow 'Певрая выделенная строка iLastRow = oSlcRange.endRow iSheet = oSlcRange.Sheet
iRange=iSheet.getCellRangeByPosition(0,iFirstRow,3,iLastRow)
arrRangeData = iRange.getDataArray()
oMerge = ThisComponent.Sheets.getByName("Merge") oRange=oMerge.getCellRangeByPosition(0,1,3,ubound(arrRangeData)+1) oRange.setDataArray(arrRangeData) ThisComponent.store
sPath=convertToURL(replace(convertFromURL(ThisComponent.URL),ThisComponent.Title,"")) 'for i = 0 to UBound(aRangeS) 'MsgBox (aRangeS(i)(0)) Templ = StarDesktop.loadComponentFromUrl(sPath & "Templ2.odt","_blank",0,dimArray())
oMailMerge = CreateUnoService("com.sun.star.text.MailMerge") With oMailMerge .DocumentURL = ConvertToURL(sPath & "Templ2.odt") .DataSourceName = "Test_fild_10" .CommandType = com.sun.star.sdb.CommandType.TABLE .Command = "Merge" .OutputType =com.sun.star.text.MailMergeType.FILE .OutputURL=OutputURL 'when output type is FILE .SinglePrintJobs=False .execute(Array()) End With
oRange.clearContents(_ com.sun.star.sheet.CellFlags.VALUE OR _ com.sun.star.sheet.CellFlags.DATETIME OR _ com.sun.star.sheet.CellFlags.STRING)
End Sub
на листе merge нужно первую строку (с заголовками полей) один раз вручную прописать
|
|
|
Записан
|
|
|
|
maksvlad
Форумчанин
 
Offline
Пол: 
Расположение: Иркутск
Сообщений: 158
|
"Заработала!" Вот что получилось Работает следующим образом Предварительные требования 1. ODS-таблица должна быть связана с базой данных (ODF) 2. ODF должна быть зарегистрирована (Сервис>параметры>LO Base>Базы данных 3. В файле шаблона sFileTmplt в качестве Источника Данных для полей должна быть указана таблица Merge в источнике ODF 4. Макрос вешается на кнопку панели с указанием имени шаблона sFileTmplt (MailMerge("01-шаблон 12.8ч1 акт")) REM ***** MAIL MERGE ***** Dim sOutFileName, sFileExt, sFileTmplt As String Sub CopyCells oSlcRange = ThisComponent.getCurrentSelection() 'Получаем Выделенное oSheet=ThisComponent.CurrentSelection.getSpreadsheet 'лист на котором выделен диапазон с данными 'MsgBox oSheet.Name If oSheet.Name <> "Merge" Then arrRangeData = oSlcRange.getDataArray() oSlcRangeAdr = ThisComponent.CurrentSelection.getRangeAddress 'Получаем адреса выделенного iFirstRow = oSlcRangeAdr.startRow 'Певрая выделенная строка iFirstClmn = oSlcRangeAdr.startColumn 'Певрая выделенная колонка iLastRow = oSlcRangeAdr.endRow iLastClmn = oSlcRangeAdr.endColumn oMerge = ThisComponent.Sheets.getByName("Merge") CleanSheet ' Merge Sheet must be 2 in book '''Copy First Row ''' oRangeAddress = oSheet.getCellRangeByPosition(0,0,iLastClmn,0).getRangeAddress() oCellAddress = oMerge.getCellRangeByName("A1").getCellAddress() oMerge.copyRange(oCellAddress, oRangeAddress) ''''Copy Selected Rows oRangeAddress = oSheet.getCellRangeByPosition(iFirstClmn,iFirstRow,iLastClmn,iLastRow).getRangeAddress() oCellAddress = oMerge.getCellRangeByName("A2").getCellAddress() oMerge.copyRange(oCellAddress, oRangeAddress) SaveSheet sOutFileName=oMerge.getCellRangeByName("A2").String 'String from Merge.A2 used for output file name with mailmerge Else MsgBox "Выделите строку на другом листе" EndIf End Sub
Sub MailMerge(sFileTmplt As String) CopyCells 'TODO: Add exeption on Merge abstn sFileExt ="doc" sFileTmplt = sFileTmplt + ".odt" sPath=convertToURL(replace(convertFromURL(ThisComponent.URL),ThisComponent.Title,"")) Templ = StarDesktop.loadComponentFromUrl(sPath & sFileTmplt,"_blank",0, dimArray()) 'TODO: Make hidden loading ''' MAIL MERGE ''' oDocSettings = Templ.createInstance("com.sun.star.text.DocumentSettings") oDBSourceName = oDocSettings.CurrentDatabaseDataSource Templ.close(true) 'MsgBox oDBSourceName 'Create a new database context and connection from the existing file 'oDBContext = CreateUnoService("com.sun.star.sdb.DatabaseContext") 'oDBSource = oDBContext.GetByName(oDBSourceName) 'oConnection = oDBSource.GetConnection("","")
'Now set up a new MailMerge using the settings extracted from that doc oMailMerge = CreateUnoService("com.sun.star.text.MailMerge") With oMailMerge .DocumentURL = ConvertToURL(sPath & sFileTmplt) .DataSourceName = oDBSourceName 'DataSource Required .CommandType = com.sun.star.sdb.CommandType.TABLE .Command = "Merge" 'Name of table for merge 'TODO: Exeption on absence of Merge sheet in book .FileNameFromColumn=True .FileNamePrefix="FileName" 'Colunm for name of output file from .SaveFilter="MS Word 97" 'contains the name of the document filter to save the output file(s) 'TODO: Use variable for FileName ' .CommandType = 1 '1 = predefined query, 2 SQL ' .Command = "sqlQuery" 'query name .OutputType =com.sun.star.text.MailMergeType.FILE ' .OutputURL=OutputURL 'when output type is FILE .SinglePrintJobs=False '.SaveAsSingleFile=True .execute(Array()) End With StarDesktop.loadComponentFromUrl(sPath & sOutFileName & "." & sFileExt,"_blank",0,dimArray()) End sub
sub CleanSheet rem ---------------------------------------------------------------------- rem define variables dim document as object dim dispatcher as object rem ---------------------------------------------------------------------- rem get access to the document document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") rem ---------------------------------------------------------------------- dim args2(0) as new com.sun.star.beans.PropertyValue args2(0).Name = "Nr" args2(0).Value = 2
dispatcher.executeDispatch(document, ".uno:JumpToTable", "", 0, args2())
rem ---------------------------------------------------------------------- dispatcher.executeDispatch(document, ".uno:SelectAll", "", 0, Array())
rem ---------------------------------------------------------------------- dispatcher.executeDispatch(document, ".uno:ClearContents", "", 0, Array())
end sub
sub SaveSheet rem ---------------------------------------------------------------------- rem define variables dim document as object dim dispatcher as object rem ---------------------------------------------------------------------- rem get access to the document document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
rem ---------------------------------------------------------------------- dispatcher.executeDispatch(document, ".uno:Save", "", 0, Array())
end sub
Sub Adm128 MailMerge("01-шаблон 12.8ч1 акт") End Sub
|
|
« Последнее редактирование: 28 Апрель 2018, 12:45 от maksvlad »
|
Записан
|
|
|
|
maksvlad
Форумчанин
 
Offline
Пол: 
Расположение: Иркутск
Сообщений: 158
|
Так я про Бейсик и писал Улыбка Смотри, правда не проверял, Спасибо! обязательно посмотрю  Есть что обрабатывать напильником 
|
|
|
Записан
|
|
|
|
|