Dear All of amazing Peoples I write code in vb6 and create report in Ms excell, but I want to create report using LibreOffice. Can someone help me to changes my code?
Option Explicit Dim MyExcel As Excel.Application Dim MyExcelWorkBook As Excel.Workbook Dim MyExcelWorksheet As Excel.Worksheet Public Enum XllineType lnormal = 1 LDash = -4115 LDashDot = 4 LDashDotDot = 5 LDot = -4118 LDouble = -4119 LSlantDashDot = 13 LNone = -4142 End Enum Public Enum XlLinePos LDiagonalDown = 5 LLeft = 7 LTop = 8 LBottom = 9 LRight = 10 End Enum Public Enum XlAlignment xlCenter = -4108 xlLeft = -4131 xlRight = -4152 xlTop = -4160 xlBottom = -4107 End Enum Public Sub OpenExcel(Optional Show As Boolean = True) Set MyExcel = CreateObject("Excel.Application") MyExcel.Visible = Show End Sub Public Sub OpenWorkBook(Optional PathAndNameXls As String = "", Optional Psw1 As String = "", Optional Psw2 As String = "") If PathAndNameXls = "" Then Set MyExcelWorkBook = MyExcel.Workbooks.Add Set MyExcelWorksheet = MyExcelWorkBook.Sheets(1) Else Set MyExcelWorkBook = MyExcel.Workbooks.Open(PathAndNameXls, , , , Psw1, Psw2) Set MyExcelWorksheet = MyExcelWorkBook.Sheets(1) End If End Sub Public Sub CloseWorkBook(Optional NoConfirm As Boolean = True) MyExcelWorkBook.Saved = NoConfirm MyExcelWorkBook.Close End Sub Public Sub CloseExcel() MyExcel.Quit Set MyExcel = Nothing End Sub Public Sub ExcelPrintPreview() MyExcel.Visible = True MyExcelWorksheet.PrintPreview MyExcel.Visible = False End Sub Public Sub PutExcelValue(y As Long, X As Long, s As String) MyExcelWorksheet.Cells(y, X).Value = s End Sub Public Sub SetCellFontSize(y As Long, X As Long, size As Long) MyExcelWorksheet.Cells(y, X).Font.size = size End Sub Public Sub SetCellFontBold(y As Long, X As Long) MyExcelWorksheet.Cells(y, X).Font.Bold = True End Sub Public Sub SetCellFontItalic(y As Long, X As Long) MyExcelWorksheet.Cells(y, X).Font.Italic = True End Sub Public Sub SetHorisontalAlignment(y As Long, X As Long, alg As XlAlignment) MyExcelWorksheet.Cells(y, X).HorizontalAlignment = alg End Sub Public Sub SetBorderLine(y As Long, X As Long, lpos As XlLinePos, ltype As XllineType) MyExcelWorksheet.Cells(y, X).Borders(lpos).LineStyle = ltype End Sub Public Sub CopyRange(Range1 As String, Range2 As String, Destination As String) MyExcelWorksheet.Range(Range1 & ":" & Range2).Copy Destination:=MyExcelWorksheet.Range(Destination) End Sub Sub PrintJurnal(noref As String) Dim rs As New ADODB.Recordset Dim Total As Double Dim NameAkun As String Dim i As Long Dim Row As Long OpenExcel True OpenWorkBook App.Path & "\jurnaldet.xls" Set rs = ExecSQL(GetDSN, "SELECT * FROM global") If rs.RecordCount > 0 Then PutExcelValue 2, 1, rs!Nama PutExcelValue 3, 1, rs!alamat & " - " & rs!kota PutExcelValue 4, 1, rs!notelp End If Set rs = ExecSQL(GetDSN, "SELECT * FROM totjurnal " & _ "WHERE referensi='" & noref & "'") If rs.RecordCount > 0 Then 'get header PutExcelValue 5, 2, ": " & noref PutExcelValue 5, 7, "User : " & rs!user PutExcelValue 6, 2, ": " & Format(rs!tanggal, "dd-mm-yyyy") PutExcelValue 7, 2, ": " & rs!keterangan Total = rs!debit Row = 9 'get detail Set rs = ExecSQL(GetDSN, "SELECT * FROM detjurnal " & _ "WHERE referensi='" & noref & "' ORDER BY nourut") If rs.RecordCount > 0 Then For i = 0 To rs.RecordCount - 1 PutExcelValue Row + i, 1, "'" & Trim(i + 1) & "." NamaAkun = GetKeterangan(GetDSN, "rekening", "kode", "namaakun", rs!kodeakun) PutExcelValue Row + i, 2, rs!kodeakun PutExcelValue Row + i, 3, NamaAkun If rs!debit > 0 Then PutExcelValue Row + i, 6, Format(rs!debit, "#,##0.00") Row = Row + 1 PutExcelValue Row + i, 3, rs!keterangan Else PutExcelValue Row + i, 7, Format(rs!kredit, "#,##0.00") Row = Row + 1 PutExcelValue Row + i, 3, rs!keterangan End If 'format text SetCellFontSize Row + i, 3, 8 SetHorisontalAlignment Row + i - 1, 6, xlRight SetHorisontalAlignment Row + i - 1, 7, xlRight rs.MoveNext Next i PutExcelValue Row + rs.RecordCount, 5, "Total:" PutExcelValue Row + rs.RecordCount, 6, Format(Total, "#,##0.00") SetHorisontalAlignment Row + rs.RecordCount, 5, xlRight SetHorisontalAlignment Row + rs.RecordCount, 6, xlRight 'border For i = 1 To 8 SetBorderLine Row + rs.RecordCount, i, LTop, lnormal Next i End If PutExcelValue Row + rs.RecordCount + 1, 1, "Terbilang : " & SayN(Total) & "Rupiah" SetCellFontSize Row + rs.RecordCount + 1, 1, 8 SetCellFontItalic Row + rs.RecordCount + 1, 1 End If ExcelPrintPreview CloseWorkBook CloseExcel End Sub Thanks before Best Regards, Henokh Yu.
_______________________________________________ LibreOffice mailing list LibreOffice@lists.freedesktop.org http://lists.freedesktop.org/mailman/listinfo/libreoffice