De Matriz direto para Área de Transferência CALC MACRO

Como transferir o conteúdo de uma matriz diretamente para a Área de Transferência do Windows no CALC por meio de MACRO?
Adianto que a minha intenção é transferir diretamente de um bloco de células, sem “Selecioná-lo”. Também seria interessante a possibilidade de optar por Copiar o conteúdo integral (formulas, etc) ou apenas texto (string)
Eis minha tentativa. Só que depois de rodá-la, a Área de Transferência apenas fica vazia.

(EDIÇÃO: RESOLVIDO)

1 Like

Ola @Jedison, não quer ir para selecionar para não mostrar troca de telas ?

Depois de copiar vai usar onde, no proprio LibreOffice ?

Oi Schiavinatto.
Sim, Minha intenção é evitar a troca de tela (ou a exposição da Aba de onde os dados serão copiados).
Li algo sobre tornar essa transição invisível, mas não tô lembrando onde vi isso.
E quero que o conteúdo fique disponível para qualquer outro aplicativo.

Já refiz o código baseado em um excerto que achei na internet e ficou melhor (edição acima), mas não consigo usar o conteúdo com o COLAR normal.

Oi Schiavinatto

Deu certo.
Estava revisando a minha última tentativa para postar aqui, e achei o erro.

Fica para Consulta.

Grato pela provocação.

Eis o código que deu certo:

    Global ClpTexto As String
Sub Copia
' Copiar um bloco de células direto para a área de transferência
Dim Plan as object
Dim Bloco as object

' Tranfere dos dados para uma Array (BLOCO)
Plan = ThisComponent.Sheets.GetByName("Sentença")    ' Para extrair de determinada aba
'Plan = ThisComponent.CurrentController.ActiveSheet  ' Para extrair da planilha ativa
Ender = Plan.GetCellRangeByName("B32:B262")
Bloco = Ender.GetDataArray()

For x = 0 to UBound(Bloco)
    sText = sText & Bloco(x)(0) & Chr(10)
Next

' Acessa a Área de Transferência
  oClip = CreateUnoService("com.sun.star.datatransfer.clipboard.SystemClipboard")
  oTransf = createUnoListener("Tr_", "com.sun.star.datatransfer.XTransferable")
' Escreve nela
  oClip.setContents(oTransf,Null)
  ClpTexto = sText
  'oClip.flushClipboard() ' does not work
End Sub
 

Function Tr_getTransferData( _
    aFlavor as com.sun.star.datatransfer.DataFlavor)
'  If (aFlavor.MimeType = "text/plain;charset=utf-16") Then
    Tr_getTransferData() = ClpTexto
'  End If
End Function
 
Function Tr_getTransferDataFlavors()
  Dim aFlavor As new com.sun.star.datatransfer.DataFlavor
  aFlavor.MimeType = "text/plain;charset=utf-16"
  aFlavor.HumanPresentableName = "Unicode-Text"
  Tr_getTransferDataFlavors() = array(aFlavor)
End Function
 
Function Tr_isDataFlavorSupported( _
    aFlavor as com.sun.star.datatransfer.DataFlavor) as Boolean
  If aFlavor.MimeType = "text/plain;charset=utf-16" Then
    Tr_isDataFlavorSupported = true
  Else
    Tr_isDataFlavorSupported = false
  End If
End Function