Keskustelu: Koodit: LibreOffice Calc & .pdf data

REM  *****  BASIC  *****

Sub OpenPDF

    Dim filepicker As Object, localFile As String, sFileArray As Variant
    filepicker = createUnoService("com.sun.star.ui.dialogs.FilePicker")
    filepicker.setDisplayDirectory(thisComponent.URL)
    filepicker.appendFilter("Portable Document Format", "*.pdf")
    filepicker.setMultiSelectionMode(False)

    If filepicker.Execute() Then
        sFileArray = filepicker.getFiles()
        localFile = sFileArray(0)
    End If

    filepicker = Nothing

    If localFile = "" Then
         MsgBox "Operation aborted by user", "48", "Open" : Exit Sub
    End If

    Dim args(0) As New com.sun.star.beans.PropertyValue
    args(0).Name = "Hidden"
    args(0).Value = True

    Dim pdfDoc As Object
    pdfDoc = StarDesktop.loadComponentFromURL(localFile, "_blank", 0, args())
    Dim oPages As Object, oPage As Object, oShape As Object

    oPages = pdfDoc.getDrawPages()

    If oPages.getCount() - 1 > 0 Then
        MsgBox "Cannot handle multipage .pdf data", "48", "Sytem"
        oPages = Nothing : pdfDoc.setModified(False)
        args = Nothing : pdfDoc.dispose() : Exit Sub
    End If

    Dim csvStr As String, prevY As Long, curY As Long
    Dim i As Integer, j As Integer, oText As Object  : csvStr = ""
    Dim start As Boolean : start = True

    For i = 0 To oPages.getCount() - 1

        oPage = oPages.getByIndex(i)

        If i = 0 Then
            Dim cntStart As Long, testShape As Object
            Dim testText As  Object
            testShape = oPage.getByIndex(0)
            testText = testShape.getText()
            If InStr(testText.getString(), "Sheet") > 0 Or _
            InStr(testText.getString(), "Taulukko") > 0 Then '(depends on locale)
                cntStart = 2
            Else
                cntStart = 0
            End If
            testText = Nothing
            testShape = Nothing
        End If

        For j = cntStart To oPage.getCount() - 1

            oShape = oPage.getByIndex(j)
            curY = oShape.Position.Y
            oText = oShape.getText()

            If oShape.supportsService("com.sun.star.drawing.TextShape") Then
                If start Then
                    prevY = curY : start = False
                End If
                If curY = prevY Then
                    csvStr = csvStr & oText.getString() & ";"
                Else
                    csvStr = csvStr & Chr(10) & oText.getString() & ";"
                    Start = True
                End If
            End IF
            prevY = curY

        Next j

    Next i

    pdfDoc.setModified(False)
    pdfDoc.dispose()
    ExportToSheet csvStr

End Sub

Sub ExportToSheet(csvStr As String)

    Dim oDoc As Object, oSheet As Object
    Dim rows() As String, oCell As Object, i As Integer

    oDoc = thisComponent
    oDoc.lockControllers
    oSheet = oDoc.CurrentController.getActiveSheet()

    rows = Split(csvStr, chr(10))

    For i = Lbound(rows) To Ubound(rows)
        rows(i) = Left(rows(i), Len(rows(i)) -1)
        Dim cols() As String
        cols = Split(rows(i), ";")'
        For j = Lbound(cols) To Ubound(cols)
            oCell = oSheet.getCellByPosition(j, i)
            If IsNumeric(cols(j)) Then
                oCell.HoriJustify = com.sun.star.table.CellHoriJustify.RIGHT
            End If
            oCell.setString(cols(j))
        Next j
        Erase cols
    Next i
    Erase rows

    oDoc.unlockControllers
    oDoc.setModified(False)

End Sub

Sub OnClose
    thisComponent.setModified(False)
End Sub