Копировать диапазон в пустую строку другого файла

[paresh]

Добрый день!
Сижу в одном кабинете с врачом. Нужно сократить время потраченное на внесение одних и тех же данных в компьютер. Пытаюсь это оптимизировать))
Имеются ли решения как из одного файла с данными копировать диапазон одной кнопкой в другой файл в следующую пустую строку? Прилагаю два файла. Из первого файла листа "маршрутный лист" нужно скопировать диапазон A58:O62 В ВИДЕ ТЕКСТА в следующие пустые строки второго файла в лист "дневной стационар".
СПАСИБО за помощь!

[bigor]

Добрый
Как вариант поторопился, копирует только формулы, а не значения

Код Выделить Развернуть

sub copyRange
Dim o
 Dim oSheet
 Dim oRange
 Dim oDoc1, oDoc2
 Dim prop(0) as new com.sun.star.beans.PropertyValue
 oDoc1=ThisComponent
 FolderName="d:\055\"
 TwoFileName="2.ods"
 oDoc2= StarDesktop.loadComponentFromUrl(convertToURL(FolderName & TwoFileName), "_blank", 0, Prop())
 oRange = oDoc1.Sheets(0).getCellRangeByName("a58:o62")
 oDoc1.CurrentController.select(oRange)
 o = oDoc1.CurrentController.getTransferable()
 lastStr = getLast(oDoc2.Sheets(0),"M1",0)
 
 oRange = oDoc2.Sheets(0).getCellRangeByName("a"&lastStr+2)
 oDoc2.CurrentController.select(oRange)
 oDoc2.CurrentController.insertTransferable(o)
 end sub


Function getLast(oSheet as Variant, sCellAddress As String, lastColumn As Boolean) As Long
Dim oCursor As Variant
Dim aRAddress As New com.sun.star.table.CellRangeAddress
    oCursor = oSheet.createCursorByRange(oSheet.getCellRangeByName(sCellAddress))
    oCursor.collapseToCurrentRegion()
    aRAddress = oCursor.getRangeAddress()
    If lastColumn Then
        getLast = aRAddress.EndColumn
    Else
        getLast = aRAddress.EndRow
    EndIf
End FunctionМакрос писал в файле 1.ods, можно повесить на кнопку или сочетание клавиш. Нужно поменять путь где лежит файл 2.ods FolderName
Файл 2 корявый, нет ни одного столбца, по которому достоверно можно установить последнюю строку. Я взял более подходящий M и удалил/заполнил  все пустые ячейки. Можно взять любой другой столбец, но все его ячейки должны быть заполнены.

[sokol92]

копирует только формулы, а не значения

Тот случай, когда можно использовать setDataArray и getDataArray.

[bigor]

Тот случай

Да, не хотелось полностью адрес диапазона рассчитывать

Код Выделить Развернуть

sub copyRange
Dim o
 Dim oSheet
 Dim oRange
 Dim oDoc1, oDoc2
 Dim prop(0) as new com.sun.star.beans.PropertyValue
 oDoc1=ThisComponent
 FolderName="/home/bigor/db/"
 TwoFileName="2.ods"
 oDoc2= StarDesktop.loadComponentFromUrl(convertToURL(FolderName & TwoFileName), "_blank", 0, Prop())
 oRange = oDoc1.Sheets(0).getCellRangeByName("a58:o62")
 a=oRange.GetDataArray()
 
 lastStr = getLast(oDoc2.Sheets(0),"M1",0)
 
 oRange = oDoc2.Sheets(0).getCellRangeByName("a"&lastStr+2 & ":o" &lastStr+6)
 oRange.setdataarray(a)
 end sub

[sokol92]

не хотелось полностью адрес диапазона рассчитывать

Лень - двигатель прогресса.

Код Выделить Развернуть

' Заполняет диапазон ячеек, начиная с верхнего левого угла oRange, содержанием массива (массивов) dataArray.
' Размер заполняемого диапазона устанавливается в соответствии с dataArray.
' Возвращает ссылку на заполненный диапазон ячеек.
Function Range_setDataArray(ByVal oRange, Byval dataArray) As Object
  Dim rangeAdr, oRange2
  Range_setDataArray=Nothing
  rangeAdr=oRange.RangeAddress
  With rangeAdr
    oRange2=oRange.SpreadSheet.getCellRangeByPosition(.StartColumn, .StartRow, .StartColumn + Ubound(dataArray(Lbound(dataArray))), .StartRow + Ubound(dataArray))
  End With
  oRange2.setDataArray dataArray
  Range_setDataArray=oRange2
End Function

[paresh]

Спасибо за помощь, но честно говоря, я плохо разбираюсь в том, что вы прислали. Мне какие-то свои данные нужно подставлять? Путь увидел, его исправил, а остальное не понял. Все, что вы написали, я вставил в свою библиотеку, но он мне выдаёт ошибку.

[bigor]

я вставил в свою библиотеку, но он мне выдаёт ошибку

Было бы хорошо увидеть ваш файл и посмотреть на что ругается.
Держите файл 1 с моими макросами (поправьте путь), добавил кнопку CopyRange, жмете ее и смотрите результат в файле 2. Дл корректной работы в столбце M файла 2 не должно быть пустых ячеек, по нему определяется последняя пустая строка.

[paresh]

Огромное спасибо!!! Поменял адрес, все работает! В файле 1.ods оставил чтобы в столбце М при отсутствие данных он оставлял нули, а в файле 2.ods наоборот прописал чтобы нули скрывались. И теперь, даже не смотря на то, что нет всех назначений, он копирует по порядку.

Теперь другой вопрос. Как присвоить вставке порядковый номер? В столбце А терапевты прописывают его вручную. Можно ли при вставке дать команду "присвоить следующий порядковый номер" в первой вставляемой строке в столбце А?

[paresh]

И как изменить лист, в который производится вставка? Что-то не нашел в коде названия листа.

[paresh]

Перенес код в исходные файлы, поменял название и путь к файлу. Выдал такую ошибку на строку "a=oRange.GetDataArray()":

Ошибка времени выполнения Basic.
Объектная переменная не установлена.

Исправил в диапазоне строчные на прописные и ошибка пропала)))

[bigor]

Начну с конца

Когда перенес код в свой файл, выдал такую ошибку

куда то вы не туда код перенесли, не находит LibreOffice его.

как изменить лист, в который производится вставка?

в этой строке oRange = oDoc2.Sheets(0).getCellRangeByName("a"&lastStr+2 & "" &lastStr+6)
Sheets(0) - первый лист, если нужен второй, то Sheets(1). Если листы перемещались, то будут проблемы с угадыванием индексов

Как присвоить вставке порядковый номер?

думать надо, как найти последний номер.

[paresh]

Отлично! Внёс изменения и всё работает!))
Листы таки перемещались. Я заново создал файл базы данных и всё вставляется как надо.
Огромное спасибо!!!

[bigor]

Нумерация
ищет последнее заполненное значение в столбце А файла 2 (оно обязательно должно быть числом) увеличивает на 1 и присваивает этот номер копируемому диапазону

Код Выделить Развернуть

sub copyRange
Dim o
 Dim oSheet
 Dim oRange
 Dim oDoc1, oDoc2
 Dim prop(0) as new com.sun.star.beans.PropertyValue
 oDoc1=ThisComponent
 FolderName="d:\055\"
 TwoFileName="2.ods"
 oDoc2= StarDesktop.loadComponentFromUrl(convertToURL(FolderName & TwoFileName), "_blank", 0, Prop())
 oRange = oDoc1.Sheets(0).getCellRangeByName("a58:o62")
 a=oRange.GetDataArray()
 
 lastStr = getLast(oDoc2.Sheets(0),"M1",0)

oEmptyRanges = oDoc2.Sheets(0).getColumns().getByIndex(0).queryEmptyCells()
If oEmptyRanges.getCount() > 0 Then nLastRow = oEmptyRanges.getByIndex(oEmptyRanges.getCount()-1).getRangeAddress().StartRow
Numb=oDoc2.Sheets(0).getCellByPosition(0,nLastRow-1).getValue
oRange = oDoc2.Sheets(0).getCellRangeByName("a"&lastStr+2 & ":o" &lastStr+6)
 a(0)(0)=Numb+1
 oRange.setdataarray(a)
 oDoc2.store
 end sub

[paresh]

Нумерация
ищет последнее заполненное значение в столбце А файла 2 (оно обязательно должно быть числом) увеличивает на 1 и присваивает этот номер копируемому диапазону

Отлично! Спасибо! Всё работает. Сделал две кнопки, одна скидывает в стационар, другая в амбулаторку. Как вас отблагодарить?

С моего компа всё работает отлично. Но с соседнего врачебного компьютера выдает ошибку.
Выделяет эту строку:
lastStr = getLast(oDoc2.Sheets(0),"L1",0)
Пишет "Ошибка времени выполнения BASIC. Подпрограмма или функция не определена."
Пробовали обновить офис до последней версии - не помогло. В чём может быть проблема? Оба файла лежат на сервере, путь к ним один и тот же.

[bigor]

В подписи есть реквизиты для доната форума, правда не знаю насколько они рабочие