Archiv des LibreOffice- und OpenOffice.org-Wiki

[ÜberSicht] [TitelIndex] [WortIndex] [SeiteFinden

(./) OOo3

Abstract.

Dieses Makro exportiert alle Diagramme in PNG-Bilddateien, die im semben Ordner liegen wie das Ausgangsdokument. Es empfiehlt sich also, das Makro nur aus Tabellenblättern aufzurufen, die bereits gespeichert wurden.

1. Problem und Lösung

1.1. Problem

1.2. Lösung

Vergleiche

' Export all charts from a Calc spreadsheet -- based on a Draft by Jose Fonseca
' Now exports shapes directly from calc without using clipboard/draw -- changed by Christian Lippka
' (cf. http://www.oooforum.org/forum/viewtopic.phtml?t=60155)

Sub Main
   Dim oDoc, oDocCtrl, oDocFrame, oDispatchHelper
   oDoc = ThisComponent
   oDocCtrl = oDoc.getCurrentController()
   oDocFrame = oDocCtrl.getFrame()
   oDispatchHelper = createUnoService( "com.sun.star.frame.DispatchHelper" )
 
   Dim storeUrl
   storeUrl = oDoc.getURL()
   if storeUrl <>"" then
     storeUrl = Left( storeUrl, Len( storeUrl ) - 4 )
   Endif

   nCharts = 0
   
   ' Search the draw page for the chart.
   Dim oSheets, oSheet, oDrawPage, oShape
   oSheets = oDoc.getSheets()
   For i = 0 to oSheets.getCount() - 1
      oSheet = oSheets.getByIndex( i )
      oDrawPage = oSheet.getDrawPage()
      For j = 0 to oDrawPage.getCount() - 1
         oShape = oDrawPage.getByIndex( j )
         ' Can't call supportsService unless the com.sun.star.lang.XServiceInfo is present.
         If HasUnoInterfaces( oShape, "com.sun.star.lang.XServiceInfo" ) Then
            If oShape.supportsService( "com.sun.star.drawing.OLE2Shape" ) Then
               ' Is it a Chart?
               If oShape.CLSID = "12DCAE26-281F-416F-a234-c3086127382e" Then
                  ' export the chart
                  nCharts = nCharts + 1
                  ExportSelection( oShape, storeUrl + "_chart_" + nCharts + ".png", "image/png" )
               EndIf
            EndIf
         EndIf
      Next
   Next
End Sub

Sub ExportSelection( oShape As Object, url As String, mediaType As String)
   ' Get an export filter object
   Dim exportFilter
   exportFilter = createUnoService( "com.sun.star.drawing.GraphicExportFilter" )
   exportFilter.setSourceDocument( oShape )
 
   ' Set the filter data
   Dim aFilterData(5) As New com.sun.star.beans.PropertyValue
   aFilterData(0).Name = "Level" '1=PS level 1, 2=PS level 2
   aFilterData(0).Value = 2
   aFilterData(1).Name = "ColorFormat" '1=color, 2=grayscale
   aFilterData(1).Value = 1
   aFilterData(2).Name = "TextMode" '0=glyph outlines, 1=no glyph outlines, see ooo bug 7918
   aFilterData(2).Value = 1
   aFilterData(3).Name = "Preview" '0=none, 1=TIFF, 2=EPSI, 3=TIFF+EPSI
   aFilterData(3).Value = 0
   aFilterData(4).Name = "CompressionMode" '1=LZW, 2=none
   aFilterData(4).Value = 2
   
   Dim aProps(2) As New com.sun.star.beans.PropertyValue
   aProps(0).Name = "MediaType"
   aProps(0).Value = mediaType
   aProps(1).Name = "URL"
   aProps(1).Value = url
   aProps(2).Name = "FilterData"
   aProps(2).Value = aFilterData()
   
   exportFilter.filter( aProps() )
End Sub 

2. Siehe auch



KategorieMakro


LizenzBedingungen | AnbieterKennzeichnung | DatenschutzErklärung | Stand: 2013-04-28