Macro for Draw to export selected object as a PNG file

English
,
#1

Hi,
I want to export selected object to PNG file. I prepared macro, but it is not working as I want to. It is exporting whole first page instead selected object.
Please help me to modify macro to export only selected object.
Thank you

Here is code:
Sub SaveSelectedObjectAsJPG()
Dim oDoc As Object
Dim oSelection As Object
Dim oExporter As Object
Dim oFilterData(3) As New com.sun.star.beans.PropertyValue
Dim sFileName As String

oDoc = ThisComponent
oSelection = oDoc.CurrentSelection

If oSelection.Count = 0 Then
    MsgBox "No object selected.", 16, "Error"
    Exit Sub
End If

sFileName = "E:\Project\!TEST.jpg" 

oFilterData(0).Name = "PixelWidth"
oFilterData(0).Value = 1024 ' Change this to your desired width
oFilterData(1).Name = "PixelHeight"
oFilterData(1).Value = 768 ' Change this to your desired height
oFilterData(2).Name = "FilterName"
oFilterData(2).Value = "draw_jpg_Export"
oFilterData(3).Name = "SelectionOnly"
oFilterData(3).Value = True

oExporter = createUnoService("com.sun.star.drawing.GraphicExportFilter")
oExporter.setSourceDocument(oSelection(0))
oExporter.filter(oFilterData())

oDoc.storeToURL(ConvertToURL(sFileName), oFilterData())
MsgBox "Object saved as JPG.", 64, "Success"

End Sub

1 Like
#2

Off: It is better to save the vectorgraphic objects into the lossless .PNG file format.

#3 
REM  *****  BASIC  *****
Option Explicit


Sub SaveSelectedObjectAsPNG()

 Dim oDoc As Object
 Dim oSelection As Object
 Dim oExporter As Object
 Dim oFilterData(3) As New com.sun.star.beans.PropertyValue
 Dim sFileName As String

	oDoc = ThisComponent

	If isEmpty(oDoc.CurrentController.getSelection) Then
    	MsgBox("No object(s) selected.", 16, "Error")
    	Exit Sub
	else
		oSelection = oDoc.CurrentSelection
		sFileName = "E:\Project\!TEST.png" 

		oFilterData(0).Name = "PixelWidth"
		oFilterData(0).Value = 1024 ' Change this to your desired width
		oFilterData(1).Name = "PixelHeight"
		oFilterData(1).Value = 768 ' Change this to your desired height
		oFilterData(2).Name = "FilterName"
		oFilterData(2).Value = "draw_png_Export"
		oFilterData(3).Name = "SelectionOnly"
		oFilterData(3).Value = True

		oExporter = createUnoService("com.sun.star.drawing.GraphicExportFilter")
		oExporter.setSourceDocument(oSelection(0))
		oExporter.filter(oFilterData())

		oDoc.storeToURL(ConvertToURL(sFileName), oFilterData())
		MsgBox("Object(s) saved as PNG.", 64, "Success")
	end if

End Sub
#4

Main route (so as not to depend on the whims of the filter):

Sub SaveSelectedObjectAsJPG2()
  Dim oDoc As Object
  Dim oSelection As Object
  Dim oGraphic As Object, oGraphicProvider As Object
  Dim filterData(1) As New com.sun.star.beans.PropertyValue
  Dim args(2) As New com.sun.star.beans.PropertyValue
  Dim sFileName As String

  oDoc = ThisComponent
  oSelection = oDoc.CurrentSelection

  If oSelection Is Nothing Then
     MsgBox "No object selected.", 16, "Error"
     Exit Sub
  End If
  
  oGraphic=oSelection(0).Graphic
  sFileName = ConvertToUrl("C:\temp\MyTest.jpg")

  filterData(0).Name = "PixelWidth"
  filterData(0).Value = 1024 ' Change this to your desired width
  filterData(1).Name = "PixelHeight"
  filterData(1).Value = 768 ' Change this to your desired height
 
  args(0).Name = "URL"
  args(0).Value = sFileName
  args(1).Name = "MimeType"
  args(1).Value = "image/jpeg"
  args(2).Name = "FilterData"
  args(2).Value = filterData

  oGraphicProvider=CreateUnoService("com.sun.star.graphic.GraphicProvider")
  oGraphicProvider.storeGraphic oGraphic, args
  MsgBox "Object saved as JPG.", 64, "Success"

End Sub
#5

This one give me error:

image
image727Ă—280 30.9 KB

#6

Thank you, but same behavior with this one as with mine.

#7

LO version?

The version of my LO is 7.5.8. I just tried with an one page Draw document containing two simple objects. It works for me wit “no selection” (warning appeared), and works with one selected objects, and with two selected objects.

Please upload your ODF type sample file here.

#8

Here is my sample file: It works in my LO 25.2.1.2 portable version too.
My macro located inside the file, and there is a custom Toolbar with one textual “button” named SaveSelectedObjectAsPNG. The macro is assigned to the toolbar item. Try it in your LO version.
ExporSelectionAsImage.odg (17.6 KB)

1 Like
#9

@Zizi64 , Your example works for me in this macro version:

Option Explicit

Sub SaveSelectedObjectAsPNG4()

 Dim oDoc As Object
 Dim oSelection As Object
 Dim oExporter As Object
 Dim args(3) As New com.sun.star.beans.PropertyValue
 Dim filterOptions(1) As New com.sun.star.beans.PropertyValue 
 Dim sFileName As String

	oDoc = ThisComponent
	oSelection=oDoc.CurrentSelection

	If oSelection Is Nothing Then
    	MsgBox("No object(s) selected.", 16, "Error")
    	Exit Sub
	Else
		sFileName = "C:\Temp\!TEST.jpg" 

        filterOptions(0).Name="PixelWidth"
        filterOptions(0).Value = 1024 ' Change this to your desired width
        filterOptions(1).Name = "PixelHeight"
		filterOptions(1).Value = 768 ' Change this to your desired height
		
		args(0).Name = "FilterData"
		args(0).Value = FilterOptions
		args(1).Name = "URL"
		args(1).Value = ConvertToUrl(sFileName)
		args(2).Name = "SelectionOnly"
		args(2).Value = True
 	    args(3).Name = "MediaType"
        args(3).Value = "image/jpeg"
		

		oExporter = createUnoService("com.sun.star.drawing.GraphicExportFilter")
		oExporter.setSourceDocument(oSelection)
		oExporter.filter(args)

		MsgBox("Object(s) saved as PNG.", 64, "Success")
	end if

End Sub

Version: 24.8.5.2 (X86_64) / LibreOffice Community
Build ID: fddf2685c70b461e7832239a0162a77216259f22
CPU threads: 6; OS: Windows 10 X86_64 (10.0 build 19045); UI render: Skia/Raster; VCL: win
Locale: ru-RU (ru_RU); UI: ru-RU
Calc: CL threaded

2 Likes
#10

Thank you all ! This one works for me!

1 Like

Impressum (Legal Info) | Datenschutzerklärung (Privacy Policy)   Content on this site is licensed under a Creative Commons Attribution Share Alike 3.0 license.