Export selection as png

English
, , , ,
#1

Greetings. I found a macro from a few years ago that works well for a project I’m working on. I was wondering if someone could help me modify it. The macro copies a range of cells, pastes it into Draw, and saves the copied cells as a png to the folder of my choosing. I’d like to skip the 2nd step (pasting it into Draw). I tried to just delete the “Paste bitmap into Draw” section, but that didn’t work. Below is the code from this post:

Sub SaveSheetAsBitmap
    'Copy from Calc.'
    oSpreadsheet = ThisComponent
    oSpreadsheetController = ThisComponent.getCurrentController()
    oSheet = oSpreadsheetController.getActiveSheet()
    'oRange = oSheet.getCellRangeByname("A1:G100")'
    'oSpreadsheetController.select(oRange)'
    oSpreadsheetController.select(oSheet)
    oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
    oSpreadsheetFrame = oSpreadsheetController.getFrame()
    oDispatcher.executeDispatch(oSpreadsheetFrame, ".uno:Copy", "", 0, Array())

    'Paste bitmap into Draw.'
    oDoc = StarDesktop.loadComponentFromUrl(_
        "private:factory/sdraw", "_blank", 0, Array())
    oDocController = oDoc.getCurrentController()
    oDocFrame = oDocController().getFrame()
    Dim props(0) As New com.sun.star.beans.PropertyValue
    props(0).Name = "SelectedFormat"
    props(0).Value = 2  'Apparently this means bitmap format'
    oDispatcher.executeDispatch(oDocFrame, ".uno:ClipboardFormatItems", "", 0, props())
    
    'Export to PNG file.'
    Dim aExportProps(1) as new com.sun.star.beans.PropertyValue
    aExportProps(0).Name = "URL"
    aExportProps(0).Value = "file:///path/to/test.png"
    aExportProps(1).Name = "MimeType"
    aExportProps(1).Value = "image/png"
    oExporter = createUnoService("com.sun.star.drawing.GraphicExportFilter")
    oExporter.SetSourceDocument(oDocController.Selection)
    oExporter.Filter(aExportProps)
End Sub

Thanks in advance!

#2

Why do you like to skip this step?

As the last step is telling draw to save, this can’t be useful, if you don’t paste first.

Where is the purpose of having a Office-Suite with Draw included, but not using it?

#4

Thank you for your reply. I’m not sure why the originator of the code saved the png to Draw, but for my purposes, I only need the png file to reside in a folder of my choosing… I don’t need to open Draw.

#6

I don’t know how to deactivate Calc PNG asking. But it is possible to open Draw in hidden window and close it after conversion.

Sub SaveSheetAsBitmap 'export selected cells to PNG via hidden Draw window
	'Copy from Calc
	oSpreadsheet = ThisComponent
	oSpreadsheetController = ThisComponent.getCurrentController()
	oSheet = oSpreadsheetController.getActiveSheet()
	oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
	oSpreadsheetFrame = oSpreadsheetController.getFrame()
	oDispatcher.executeDispatch(oSpreadsheetFrame, ".uno:Copy", "", 0, Array()) 'copy selection
	
	'Paste bitmap into Draw
	dim pr(0) as new com.sun.star.beans.PropertyValue 'hidden Draw window
		pr(0).Name="Hidden" : pr(0).Value=true
	oDoc = StarDesktop.loadComponentFromUrl("private:factory/sdraw", "_blank", 0, pr())
	oDocController = oDoc.getCurrentController()
	oDocFrame = oDocController().getFrame()
	Dim props(0) As New com.sun.star.beans.PropertyValue
	props(0).Name = "SelectedFormat"
	props(0).Value = 2  'Apparently this means bitmap format
	oDispatcher.executeDispatch(oDocFrame, ".uno:ClipboardFormatItems", "", 0, props())
	
	'Export to PNG file
	dim sUrl$
	sUrl=ConvertToUrl("file:///d:/test.png") 'your PNG file
	Dim aExportProps(1) as new com.sun.star.beans.PropertyValue
	aExportProps(0).Name = "URL"
	aExportProps(0).Value = sUrl
	aExportProps(1).Name = "MimeType"
	aExportProps(1).Value = "image/png"
	oExporter = createUnoService("com.sun.star.drawing.GraphicExportFilter")
	oExporter.SetSourceDocument(oDocController.Selection)
	oExporter.Filter(aExportProps)
	oDoc.close(true)
	msgbox(sUrl & chr(13) & "Exported")
End Sub
#8

This works for me. Thank you very much! I appreciate it.

#9

Midnight idea without Draw :slight_smile:

Sub Cells2PNG 'export selected cells to PNG
	dim oDoc as object, oSel as object, sInitDir$, sUrl$
	sInitDir=ConvertToUrl("d:\") 'OUTPUT DIRECTORY
	oDoc=ThisComponent
	oSel=oDoc.CurrentController.Selection 'current selection
	if oSel.supportsService("com.sun.star.sheet.SheetCellRange") then 'some cells are selected
		'set name of PNG in FilePicker dialog
		const cExt=".png"
		dim oDlg as object, listAny(0) as long
		listAny(0)=com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_AUTOEXTENSION
		oDlg=CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
		with oDlg
			.initialize(listAny)
			.appendFilter("PNG - Portbale Network Graphic (" & cExt & ")",  cExt)
			.setValue(com.sun.star.ui.dialogs.ExtendedFilePickerElementIds.CHECKBOX_AUTOEXTENSION, 0,  true)
			.setDisplayDirectory(sInitDir)
		end with
		if oDlg.Execute()<>1 then exit sub
		sUrl=oDlg.Files(0) 'url of the PNG	
		oDlg.dispose()
		'copy&paste&export2PNG
		uno(oDoc, "Copy") 'copy cells
		dim props(0) as new com.sun.star.beans.PropertyValue
			props(0).Name="SelectedFormat" : props(0).Value=2  'apparently this means bitmap format
		uno(oDoc, "ClipboardFormatItems", props) 'paste as graphic
		dim oExporter as object
		dim aExportProps(1) as new com.sun.star.beans.PropertyValue
			aExportProps(0).Name="URL" : aExportProps(0).Value=sUrl
			aExportProps(1).Name="MimeType" : aExportProps(1).Value="image/png"
		oExporter=createUnoService("com.sun.star.drawing.GraphicExportFilter")
		with oExporter 'export to PNG file
			.SetSourceDocument(oDoc.CurrentController.Selection)
			.Filter(aExportProps)
		end with
		uno(oDoc, "Delete") 'delete pasted graphic
		oDoc.CurrentController.Select(oSel) 'select primal selection
	end if
End Sub

Sub uno(oDoc as object, s$, optional a()) 'execute .uno command
	if isMissing(a) then a=array()
	s=".uno:" & s 'uno command
	createUnoService("com.sun.star.frame.DispatchHelper").executeDispatch(oDoc.CurrentController.Frame, s, "", 0, a)
End Sub
#10

:grinning_face_with_smiling_eyes:

Indeed, why open the Draw if we already have an opened Calc.

Maybe it makes sense to use “Undo” instead of “Delete”?

#11

Hello how to export png file with transparent background (What’s the FilterProperty)
like the UI displayed (Save Transparency)
wm

#3

Use the Macro Recorder to see the PNG export is diifferent in Calc than your macro.


Sub CalcExport2png
	dim document   as object
	dim dispatcher as object
	document   = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
	dim args2(3) as new com.sun.star.beans.PropertyValue
	args2(0).Name = "URL"
	args2(0).Value = "file:///d:/aaa.png"
	args2(1).Name = "FilterName"
	args2(1).Value = "calc_png_Export"
	args2(2).Name = "FilterData"
	args2(2).Value = Array(Array("Compression",0,9,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("Interlaced",0,1,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("Translucent",0,0,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("PixelWidth",0,196,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("PixelHeight",0,98,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("LogicalWidth",0,4525,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("LogicalHeight",0,2262,com.sun.star.beans.PropertyState.DIRECT_VALUE))
	args2(3).Name = "SelectionOnly"
	args2(3).Value = true
	dispatcher.executeDispatch(document, ".uno:ExportTo", "", 0, args2())
End Sub
#5

Thank you for your reply. I tried the macro recorder as well. One of the reasons I chose the macro I posted above was it removed the popup asking for the png dimensions that the one from the macro recorder spits out. The macro I posted above allows me to select a range of cells and then it exports those cells as a png to the folder of my choosing (no png dimensions popup). I was hoping to just modify the macro a bit to make it work for me, but whenever I delete a line, it breaks the macro, lol.

#7

You may be able to adapt this to your project (but most likely not)

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