Below is a short commentary and the macro text (this may be more convenient for some forum readers). Macro specifications precede their headers.
The InsertGraphicFromClipBoard macro scans all clipboard formats and selects data from the most appropriate mime type. The default value of the aMimeTypes parameter is subject to further discussion.
The InsertGraphicFromClipBoard macro creates a temporary file with data of the appropriate clipboard format and inserts this (graphic) file into a LibreOffice document (Calc, Writer, Impress, etc.).
The ShowClipboardContents macro is auxiliary and displays the clipboard contents (a list of all formats) in a new Calc document.
Option Explicit
Option Compatible
' Inserts an image into a LibreOffice document from a graphic file.
' The mime type is detected automatically.
Sub InsertGraphicFromFile(ByVal oDoc As Object, Byval filePath As String) As Boolean
Dim props(0) as New com.sun.star.beans.PropertyValue
Dim oDisp As Object
oDisp = CreateUnoService("com.sun.star.frame.DispatchHelper")
props(0).Name = "FileName"
props(0).Value = ConvertToUrl(filePath)
oDisp.executeDispatch(oDoc.CurrentController.Frame, ".uno:InsertGraphic", "", 0, props)
End Sub
' Inserts an image into a LibreOffice document from Clipboard.
' The aMimeTypes parameter is described in `GetRelevantDataFromClipBoard` macro.
Function InsertGraphicFromClipBoard(Optional ByVal oDoc As Object, Optional Byval aMimeTypes) As Boolean
Dim clipData, oTempFile As Object, aData() As Byte
If IsMissing(oDoc) Then oDoc = ThisComponent
If IsMissing(aMimeTypes) Then
aMimeTypes = Array("application/x-openoffice-gdimetafile", "application/x-openoffice-emf", "image/svg+xml", "image/png", "image/*") ' ???
End if
clipData= GetRelevantDataFromClipBoard(aMimeTypes)
If Not IsArray(clipData) Then Exit Function
oTempFile = CreateUnoService("com.sun.star.io.TempFile")
aData = clipData(2)
oTempFile.writeBytes aData
oTempFile.closeOutput
InsertGraphicFromFile oDoc, oTempFile.Uri
InsertGraphicFromClipBoard = True
End Function
' Returns the preferred data format from the clipboard.
' aMimeTypes specifies an array of mime type names in descending order of preference.
' The mime type name is case-insensitive; the wildcard characters * and ? are allowed.
' If the preferred format is found, an array of three elements is returned:
' the index; the DataFlavor structure; the clipboard data as a byte array.
' If the preferred format is not found, Empty is returned.
Function GetRelevantDataFromClipBoard(Byval aMimeTypes)
Dim oContents As Object, oTransferDataFlavors As Object
Dim oDoc As Object, oSheet As Object
Dim i As Long, arr, aData() As Byte, item
GetRelevantDataFromClipBoard = Empty
oContents = CreateUnoService("com.sun.star.datatransfer.clipboard.SystemClipboard").getContents()
If oContents Is Nothing Then Exit Function
oTransferDataFlavors = oContents.getTransferDataFlavors()
ReDim arr(Ubound(oTransferDataFlavors))
For i=0 To Ubound(oTransferDataFlavors)
arr(i) = oTransferDataFlavors(i).MimeType
If Instr(1, arr(i), ";")>0 Then arr(i) = Split(arr(i), ";")(0)
Next i
For Each item In aMimeTypes
For i = 0 To Ubound(arr)
If Lcase(arr(i)) Like Lcase(item) Then
aData = oContents.getTransferData(oTransferDataFlavors(i))
GetRelevantDataFromClipBoard = Array(i, oTransferDataFlavors(i), aData)
Exit Function
End If
Next i
Next item
End Function
' Shows the clipboard table of contents in a new Calc document.
Sub ShowClipboardContents()
Dim oContents As Object, oTransferDataFlavors As Object, oTransferDataFlavor As Object
Dim oDoc As Object, oSheet As Object
Dim i As Long, arr
oContents = CreateUnoService("com.sun.star.datatransfer.clipboard.SystemClipboard").getContents()
If oContents Is Nothing Then Exit Sub
oTransferDataFlavors = oContents.getTransferDataFlavors()
ReDim arr(Ubound(oTransferDataFlavors))
For i=0 To Ubound(oTransferDataFlavors)
oTransferDataFlavor = oTransferDataFlavors(i)
With oTransferDataFlavor
arr(i) = Array(i, .HumanPresentableName, .MimeType)
End With
Next i
oDoc = StarDesktop.LoadComponentFromUrl("private:factory/scalc","_default",0,Array())
oSheet = oDoc.Sheets(0)
oSheet.getCellRangeByPosition(0, 0, 2, 0).setDataArray Array(Array("Ind", "PresentableName", "Mime type"))
oSheet.getCellRangeByPosition(0, 1, UBound(arr(0)), UBound(arr) + 1).setDataArray arr
' Format range.
For i = 0 To 1
oSheet.Columns(i).OptimalWidth=True
Next i
End Sub
