LibreOffice-Forum

Code: Alles auswählen

Sub Main
Dim oDoc As Object
oDoc = ThisComponent
MsgBox oDoc.GetUrl(), 0, "oDoc.GetUrl()"
Dim bIsTextDoc As Boolean
bIsTextDoc = (oDoc.SupportsService("com.sun.star.text.TextDocument")) 'Test if it is a text document
If bIsTextDoc Then
    MsgBox "Das aktuelle Dokument ist ein Textdokument.", MB_OK + MB_ICONEXCLAMATION, "Textdokument"
End If
Dim bSupportsExport As Boolean
bSupportsExport = (oDoc.SupportsService("com.sun.star.document.ExportFilter")) 'Check if the document supports the export service
If Not bSupportsExport Then
    MsgBox "Das aktuelle Dokument unterstützt keine Exportfunktion.", MB_OK + MB_ICONEXCLAMATION, "Kein Export möglich"
End If
End Sub

Code: Alles auswählen

Sub StoreEachPageToPNG()
    Dim oDoc As Variant, oViewCursor As Variant
    Dim sOriginalURL As String, sFileURL As String, nPage As Integer
    Dim aFilterData(4) As New com.sun.star.beans.PropertyValue
    aFilterData(0).Name = "PixelWidth"
    aFilterData(0).Value = 2048
    aFilterData(1).Name = "PixelHeight"
    aFilterData(1).Value = Int(aFilterData(0).Value * Sqr(2))
    aFilterData(2).Name = "Compression"
    aFilterData(2).Value = 9
    aFilterData(3).Name = "InterlacedMode"
    aFilterData(3).Value = False
    aFilterData(4).Name = "TranslucentMode"
    aFilterData(4).Value = False
    
    Dim aStoreProperties(1) As New com.sun.star.beans.PropertyValue
    aStoreProperties(0).Name = "FilterName"
    aStoreProperties(0).Value = "writer_png_Export"
    aStoreProperties(1).Name = "FilterData"
    aStoreProperties(1).Value = aFilterData
    
    oDoc = ThisComponent
    oViewCursor = oDoc.getCurrentController().getViewCursor()
    sOriginalURL = oDoc.getURL()
    nPage = 1
    oViewCursor.jumpToFirstPage()
    Do 
        sFileURL = Replace(sOriginalURL, ".odt", "-" & Format(nPage, "0000") & ".png")
        oDoc.storeToURL(sFileURL, aStoreProperties)
        nPage = nPage + 1
    Loop While oViewCursor.jumpToNextPage()
End Sub