Форум поддержки пользователей. LibreOffice, Apache OpenOffice, OpenOffice.org

Форум поддержки пользователей. LibreOffice, Apache OpenOffice, OpenOffice.org

28 Ноябрь 2020, 19:31 *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

Войти
Новости: Часто задаваемые вопросы по LibreOffice и Apache OpenOffice.org
 
   Начало   Помощь Поиск Войти Регистрация    задать вопрос  
Страниц: 1   Вниз
  Печать  
Автор Тема: Макрос для копирования диапазона ячеек, как картинки  (Прочитано 769 раз)
0 Пользователей и 1 Гость смотрят эту тему.
kompilainenn
Мастер
*****
Offline Offline

Сообщений: 3 092



« Стартовое сообщение: 21 Октябрь 2020, 15:49 »

Господа хорошие, помогите. Нужен макрос, который бы делал следующее:

Брал выделенный диапазон ячеек в Calc (даже одна текущая ячейка считается тоже!)
Копировал этот диапазон в буфер обмена, как картинку (PNG или JPG не важно) с хорошим качеством и цветную
Не задавал никаких вопросов про качество и размер картинки (есть при стандартном экспорте дополнительные диалоги, так вот они в моем случае не треба)

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

Поддержать разработчиков LibreOffice можно тут, а наш форум вот тут
sokol92
Форумчанин
***
Offline Offline

Пол: Мужской
Сообщений: 227


WWW
« Ответ #1: 21 Октябрь 2020, 21:12 »

В буфер обмена не умею, в файл можно так:

Код:
' Сохраняет выделенную область как картинку в файле fileName
' fileType - тип файла: jpg или png. Умолчание - если расширение файла .png, то png, иначе jpg
Sub SelectionToPic(Byval fileName, Optional Byval fileType)
   Dim args(2) as new com.sun.star.beans.PropertyValue
   Dim args2(0) as new com.sun.star.beans.PropertyValue
 
   If IsMissing(fileType) Then
     fileType =IIf(Right(Lcase(fileName), 4)=".png", "png", "jpg")
   Else
     fileType=Lcase(fileType)
     If fileType<>"jpg" and fileType<>"png" Then fileType="jpg"
   End If 
   
   args2(0).Name="Quality": args2(0).Value=100  ' качество (максимум 100)
   
   args(0).Name = "FilterName"   : args(0).Value = "calc_" & FileType & "_Export"
   args(1).Name = "FilterData"   : args(1).Value=args2
   args(2).Name = "SelectionOnly": args(2).Value = True
   
  ThisComponent.storeToUrl(ConvertToURL(fileName), args)
End  Sub

Sub Test
  SelectionToPic("C:\temp\Test.jpg")
  SelectionToPic("C:\temp\Test.png")
End Sub

Сохранение в .png производится без потери качества, размер файла при этом значительно меньше, чем .jpg
« Последнее редактирование: 22 Октябрь 2020, 13:30 от sokol92 » Записан

Владимир.
economist
Форумчанин
***
Offline Offline

Сообщений: 1 314


« Ответ #2: 22 Октябрь 2020, 11:08 »

Что интересно - макрос 100% работает и во Writer, экспортируя всю текущую страницу ODT с разрешением примерно 160-200 dpi (очень подходит для архивного хранения в цвете, на лазерной распечатке - точь-в-точь как ксерокопия). Полезный пример! 
Записан

Руб. за сто, что Питоньяк
Любит водку и коньяк!
Потому что мне, без оных, -
Не понять его никак...
kompilainenn
Мастер
*****
Offline Offline

Сообщений: 3 092



« Ответ #3: 22 Октябрь 2020, 13:15 »

В буфер обмена не умею
очень жаль, нужно в буфер обмена, файл на диске просто не нужен =(
Записан

Поддержать разработчиков LibreOffice можно тут, а наш форум вот тут
sokol92
Форумчанин
***
Offline Offline

Пол: Мужской
Сообщений: 227


WWW
« Ответ #4: 22 Октябрь 2020, 13:40 »

Уточнил макрос в #1.

Насколько я знаю, в буфер обмена выделенные ячейки копируются командой диспетчера .uno:Copy (сразу во многих форматах буфера обмена, включая графику), выделенный лист (листы) - командой диспетчера .uno:Move (c параметром Copy=True).
« Последнее редактирование: 22 Октябрь 2020, 13:43 от sokol92 » Записан

Владимир.
kompilainenn
Мастер
*****
Offline Offline

Сообщений: 3 092



« Ответ #5: 22 Октябрь 2020, 16:20 »

Возможно можно обыграть использование функции Экспорт в (.uno:ExportTo)?
Записан

Поддержать разработчиков LibreOffice можно тут, а наш форум вот тут
sokol92
Форумчанин
***
Offline Offline

Пол: Мужской
Сообщений: 227


WWW
« Ответ #6: 22 Октябрь 2020, 17:25 »

Эту функцию я смотрел (обращение к ней записывает макрорекордер)  - функция вызывает диалог и после ответа пользователя формирует файл так же, как в ответе #1 (но в #1 действий пользователя не требуется). Проблема (как я понимаю) - занести в буфер обмена один формат вместо многих. Может быть, через методы LO Draw (сохранить диапазон Calc способом из #1 во временный файл png или jpg, открыть этот файл в LO Draw и скопировать в буфер обмена)? Получается (если получается) громоздко...
« Последнее редактирование: 22 Октябрь 2020, 17:29 от sokol92 » Записан

Владимир.
kompilainenn
Мастер
*****
Offline Offline

Сообщений: 3 092



« Ответ #7: 22 Октябрь 2020, 19:21 »

хаха, забавно.
Копируем диапазон, как есть
Пробуем вставить в ГИМП - вставляет КАРТИНКУ, как и требуется. То есть, ЛО копирует в буфер в нескольких форматах сразу и среди форматов есть картинка!
А если вставить в почтовый клиент, то вставляет таблицей, которую можно править

Задача макроса - оставить только графический формат в буфере обмена при обычном копировании
Записан

Поддержать разработчиков LibreOffice можно тут, а наш форум вот тут
economist
Форумчанин
***
Offline Offline

Сообщений: 1 314


« Ответ #8: 22 Октябрь 2020, 20:03 »

Ровно то что вы хотите делает расширение для Тундры https://addons.thunderbird.net/ru/thunderbird/addon/attach-from-clipboard/?src=search


* ВставкаБуфераКакРисВThunderBird.jpg (37.2 Кб, 633x474 - просмотрено 9 раз.)
Записан

Руб. за сто, что Питоньяк
Любит водку и коньяк!
Потому что мне, без оных, -
Не понять его никак...
sokol92
Форумчанин
***
Offline Offline

Пол: Мужской
Сообщений: 227


WWW
« Ответ #9: 22 Октябрь 2020, 20:06 »

Собрал макрос SelectionAsPicToClip из лоскутов. Правда, пока "подмигивает".
Код:
Option Explicit
' --------------------------------------------------------------------------------
' Копирует диапазон ячеек как картинку в буфер обмена
Sub SelectionAsPicToClip()
  Dim tempFile, oDoc
  tempFile=GetTempFileName("png")
  SelectionToPic(tempFile)
  oDoc=StarDesktop.LoadComponentFromUrl(TempFile, "_blank", 0, Array()) 
  CopyToClipboard_Dispatch(oDoc)   
  oDoc.Close(False)
  Kill tempFile 
End Sub

' --------------------------------------------------------------------------------
' Сохраняет выделенную область как картинку в файле fileName
' fileType - тип файла: jpg или png. Умолчание - если расширение файла .png, то png, иначе jpg
Sub SelectionToPic(Byval fileName, Optional Byval fileType)
   Dim args(2) as new com.sun.star.beans.PropertyValue
   Dim args2(0) as new com.sun.star.beans.PropertyValue
 
   If IsMissing(fileType) Then
     fileType =IIf(Right(Lcase(fileName), 4)=".png", "png", "jpg")
   Else
     fileType=Lcase(fileType)
     If fileType<>"jpg" and fileType<>"png" Then fileType="jpg"
   End If 
   
   args2(0).Name="Quality": args2(0).Value=100  ' качество (максимум 100)
   
   args(0).Name = "FilterName"   : args(0).Value = "calc_" & FileType & "_Export"
   args(1).Name = "FilterData"   : args(1).Value=args2
   args(2).Name = "SelectionOnly": args(2).Value = True
   
  ThisComponent.storeToUrl(ConvertToURL(fileName), args)
End  Sub

' --------------------------------------------------------------------------------
' Копирует содержимое документа в буфер обмена
' Автор: A.Питоньяк
Sub CopyToClipboard_Dispatch(Byval oDoc)
  dim document   as object
  dim dispatcher as object
  document   = oDoc.CurrentController.Frame

  ' This next line was NOT added by the macro recorder.
  ' Without the next line, this fails in LO when called from a button.
  document.ContainerWindow.setFocus

  dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
  dispatcher.executeDispatch(document, ".uno:SelectAll", "", 0, Array())
  dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
End Sub

' Возвращает имя временного файла (URL) с расширением ext
Function GetTempFileName(ext)
  Dim oPathSubstitution
  oPathSubstitution=CreateUnoService("com.sun.star.util.PathSubstitution")
  GetTempFileName=oPathSubstitution.getSubstituteVariableValue("$(temp)") & "/T" & getSystemTicks() & "." & ext
End Function
Записан

Владимир.
Bigor
Мастер
*****
Offline Offline

Пол: Мужской
Сообщений: 1 017


« Ответ #10: 23 Октябрь 2020, 14:16 »

А разве поправили выгрузку jpeg и png  с разрешением только 96 dpi ?
Записан

Поддержать разработчиков LibreOffice можно можно тут, а наш форум вот тут
kompilainenn
Мастер
*****
Offline Offline

Сообщений: 3 092



« Ответ #11: 23 Октябрь 2020, 21:16 »

А разве поправили выгрузку jpeg и png  с разрешением только 96 dpi ?
без понятия.
в принципе мне подсказали решение, которое не связано с Либрой, а связано с тем софтом, куда мне надо было картинку вставлять, там есть аналог Вставить как..., где можно выбрать ПНГ, после копирования из Кальк.
Записан

Поддержать разработчиков LibreOffice можно тут, а наш форум вот тут
Страниц: 1   Вверх
  Печать  
 
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2009, Simple Machines Valid XHTML 1.0! Valid CSS!