1 (изменено: Poltergeyst, 2010-08-23 21:07:24)

Тема: OOo Basic: сохранение диаграммы OOo Calc в изображение

Макрос OOo Basic предназначен для экспорта диаграммы, расположенной на активном листе документа OOo Calc, в png-изображение. Откройте документ chart_png.ods, нажмите кнопку "Сохранить диаграмму" на форме активного листа и укажите имя файла для сохранения.

Lang: o_O Basic, Open Office 2.x, OC WinMe/XP

'---------------------------------------------------------------------------
' Макрос предназначен для экспорта диаграммы, расположенной на активном листе, 
' в png-изображение. 
'
' Lang: O_o Basic
'---------------------------------------------------------------------------

'[Сохранение диаграммы с помощью фильтра "com.sun.star.drawing.GraphicExportFilter"]
'---------------------------------------------------------------------------
Sub SaveDiagramToPng()

    oSheet = ThisComponent.CurrentController.ActiveSheet()
    '-----------------------------------------------------------------------
    oCharts = oSheet.getCharts()
    If oCharts.getCount() = 0 Then 
        MsgBox "На активном листе отсутствуют диаграммы.",16,"Error"
        Exit Sub
    End If
    '-----------------------------------------------------------------------
    sSavePath = SaveFileDlg()
    If Len(sSavePath) = 0 Then Exit Sub
    '-----------------------------------------------------------------------
    '/Выбирается диаграмма с индексом 0, но можно попробовать 
    'идентифицировать диаграмму по имени/
    
    oChart = oCharts.getByIndex(0)
    oDraw = oChart.getEmbeddedObject.getDrawPage()
    '-----------------------------------------------------------------------
    oFilter = CreateUnoService("com.sun.star.drawing.GraphicExportFilter")
    Dim args(1) As New com.sun.star.beans.PropertyValue
    oFilter.setSourceDocument(oDraw)
    args(0).Name = "URL"
    args(0).Value = sSavePath
    args(1).Name = "MediaType"
    args(1).Value = "image/png"
    oFilter.Filter(args())
    '-----------------------------------------------------------------------
    MsgBox "Готово",64, "Сохранение диаграммы"

End Sub    

'[Диалог сохранения файла]
'---------------------------------------------------------------------------
Function SaveFileDlg()

    oPS = createUnoService("com.sun.star.util.PathSettings")
    oFileDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
    '-----------------------------------------------------------------------    
    oFileDialog.Initialize(Array(com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_AUTOEXTENSION))
    oFileDialog.setValue(com.sun.star.ui.dialogs.ExtendedFilePickerElementIds.CHECKBOX_AUTOEXTENSION,0, true)
    '-----------------------------------------------------------------------
    Dim FilterNames(0) As String
    FilterNames(0) = "*.png"
    oFileDialog.AppendFilter(FilterNames(0), FilterNames(0))
    oFileDialog.SetCurrentFilter(FilterNames(0))
    '-----------------------------------------------------------------------
    oFileDialog.setDisplayDirectory(oPS.getPropertyValue("Work"))
    '-----------------------------------------------------------------------
    If oFileDialog.Execute() = 1 Then
        SaveFileDlg = oFileDialog.Files(0)
    End If
    oFileDialog.Dispose()

End Function
'---------------------------------------------------------------------------
'pltrgst
Post's attachments

chart_exp1.zip 24.12 kb, 184 downloads since 2010-08-08 

You don't have the permssions to download the attachments of this post.