[Решено] Макрос рассылки из выделенной строки Calc в документ Writer

[maksvlad]

Предыдущий заголовок темы "Нужен макрос передачи данных из выделенной строки Calc в документ Writer"
Здравствуйте, уважаемые форумчане!

Не знаю с какой стороны подойти к такой задачке:
Есть таблица в ods, данные из которой используются для заполнения полей в документе odt (а-ля "Рассылка писем")
В настоящий момент используется не слишком удобная последовательность в работе:
Заполнить данные в таблице ods -> Открыть документ odt (Ручное Управление (РУ)) -> выбрать строку с данными в источнике данных (РУ) -> пустить на печать (РУ) -> сохранить сформированный документ (с данными в полях) (РУ) -> открыть  сформированный документ для обработки напильником (РУ)

Желаемый результат:
Заполнить данные в таблице ods -> выбрать в таблице строку (строки) с данными -> сформировать документ odt с заполненными полями (Железный Механизм (ЖМ))-> сохранить документ в указанном месте (ЖМ) -> открыть сформированный документ odt для обработки напильником (ЖМ)

Подскажите, люди добрые, куда копать?

[Bigor]

Так?

[maksvlad]

Так?

Спасибо огромное за пример! Последовательность отрабатывает как описано
Щас только разберусь как начинку из закладок на поля слияния базы данных перевести и можно будет пользовать ))

[maksvlad]

Чуть переделал пример, что благодушно предоставил Bigor (за что ему еще раз БОЛЬШОЕ спасибо!)

Что у меня получилось: отрабатывается вызов шаблона и формирование рассылки писем (MailMerge) с полями с нужными данными

Что не получилось: не получается отфильтровать источник записей по строке, выделенной в ods файле.
Для фильтра использовал поле А1.
При выполнении скрипта формируются файлы по всем строкам с данными, которые есть в файле ods

N.B. Для работы скрипта надо зарегистрировать базу данных "Test_fild_1", предоставляющую доступ к файлу Test_fild_1.ods

[Bigor]

Мысли:
1. Если нужны поля, то поискать решения по заполнению их макросом без использования рассылки
2. Если нужна рассылка, но не получается выбрать нужное запросом, макросом копируем нужные данные на второй лист и на него натравливаем рассылку

[maksvlad]

Мысли:
1. Если нужны поля, то поискать решения по заполнению их макросом без использования рассылки

Мне предложенное решение с закладками понравилось. Минус для текущей ситуации в том, что все становится завязанным на макрос и все связки столбцов и закладок надо прописывать в макрос. Сейчас несколько таблиц-источников (10-15 столбцов) и около десятка шаблонов, в каждом из которых одно поле из таблицы может использоваться несколько раз в разных местах. Перелопачивать времени нет. Тем более, что просится давно другое решение. Но покаиспользуется этот костыль.
Рассылка - это не самоцель. Это механизм, который уже работает с минимальными телодвижениями в области макросо и скриптописания

2. Если нужна рассылка, но не получается выбрать нужное запросом, макросом копируем нужные данные на второй лист и на него натравливаем рассылку

Вот за это спасибо. Вот это будет проще всего. Тем более, что несколько лет назад так и делалось... Только руками.

Пока серфил по просторам ЛОО и ООо форумов, читал предложение на привязку не к таблице, а к запросу. Правда за пять минут ковыряния палочкой результата такое решение не дало. Точнее вообще не заработало. А так ещё один вариант

[maksvlad]

Продолжаю изыскания...
Что получилось:
1. Первая строка текущего листа и выделенная строка копируются в лист Merge
2. Запускается слияние. выдается файл с нужными данными в полях

Что не работает. Результат можно получить только один раз после первого запуска скрипта.
Последующие вызовы скрипта приводят к тому, что формируются файлы с данными, выбранными при первом запуске.
Как я полагаю, база данных предоставляющая доступ к таблице блокируется Writer, что требует перезапуска LO...

Вопрос, как снять блокировку?

N.B. Для работы скрипта надо зарегистрировать базу данных "Test_fild_10", предоставляющую доступ к файлу Test_fild_1.ods

[Bigor]

Пробуй

Почистил немного, и добавил отключение от БД, хотя сомневаюсь, что там нужно и подключение

[maksvlad]

Пробуй

Почистил немного, и добавил отключение от БД, хотя сомневаюсь, что там нужно и подключение

Спасибо за участие. Честно говоря, я не понял, где подключение к БД (ну и отключение) в файле был этот скрипт

Код:

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

[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 ячейки?
Можно получить диапазон из одной  (нескольких вертикальных) ячеек, узнать номер первой последней строки, и сформировать новый диапазон добавив адреса нужных столбцов

[maksvlad]

Щелкни на номере строки, только зачем тебе вся строка в ней 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]

"Заработала!"
Вот что получилось
Работает следующим образом
Предварительные требования
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

[maksvlad]

Так я про Бейсик и писал Улыбка
Смотри, правда не проверял,

Спасибо! обязательно посмотрю Есть что обрабатывать напильником