Автор Тема: LibreOffie/OpenOffice вставка заданной строки, макрос  (Прочитано 2407 раз)

Оффлайн stranger573

  • Мастер
  • ***
  • Сообщений: 1 286
    • Email
   Поднадоело заколачивать руками дату и время. Накропал макрос который можно назначить на хоткей, кнопку или в меню.
Да, я в курсе, что есть "Ctrl+;" и "Ctrl+Shift+;". Однако, оно в старых версиях OOo/LO либо совсем не работает, либо работает неадекватно. Кроме того, действует только в Calc (в Writer можно вставить поля дату и время). Там, где работает, выводимый формат зависит от региональных настроек, настроек полей, формата даты в документе или шаблоне, формата ячейки и т.д.
   Данный макрос использует буфер обмена, поэтому работоспособен во всех компонентах OOo/LO. Проверялся в версиях с OOo-3.0 по LO-6.2.8.2.  Выводит текущие дату и время в формате "dd.mm.yyyy hh:mm" (настраивается в макросе, в функции CreateString()). Содержание строки можно при желании заменить на любое другое часто используемое (например, как во вложении).
   Строка вставляется в позицию курсора (в Writer и при установке курсора в строку ввода в Calc) или заменяет выделенное в текстовой строке или при выделении ячейки Calc. Чтобы при вставке в выделенную ячейку Calc  не выворачивало формат надо предварительно установить формат ячейки в текстовый или сначала ввести апостроф, в противном случае дата и время будут в числовом виде, как задано в настройках шаблона или документа.

REM  *****  BASIC  *****

REM Thanks Andrew Pitonyak

Private oTRX

Sub InsertDataTimeAsString
  Dim null As Object
  Dim sClipName As String

  sClipName = "com.sun.star.datatransfer.clipboard.SystemClipboard"
  oClip = createUnoService(sClipName)
  oTRX = createUnoListener("TR_", "com.sun.star.datatransfer.XTransferable")
  oClipContents = oClip.setContents(oTRX, null)

  Dim document   as object
  Dim dispatcher as object

  document   = ThisComponent.CurrentController.Frame
  dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
  dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array())
End Sub

Function TR_getTransferData(aFlavor As com.sun.star.datatransfer.DataFlavor) As Any
  If (aFlavor.MimeType = "text/plain;charset=utf-16") Then
    TR_getTransferData = CreateString()
  EndIf
End Function

Function TR_getTransferDataFlavors() As Any
  Dim aF As New com.sun.star.datatransfer.DataFlavor
  aF.MimeType = "text/plain;charset=utf-16"
  aF.HumanPresentableName = "Unicode-Text"
  TR_getTransferDataFlavors = Array(aF)
End Function

Function TR_isDataFlavorSupported(aFlavor As _
com.sun.star.datatransfer.DataFlavor) As Boolean
  TR_isDataFlavorSupported = (aFlavor.MimeType = "text/plain;charset=utf-16")
End Function

Function CreateString() As String
  Dim fString As String
  fString = "dd.mm.yyyy hh:mm"
  CreateString = Format(Now(), fString)
End Function
« Последнее редактирование: 19.09.2020 01:53:08 от stranger573 »