Can someone help me to changes my code?

[Henokh Yudhistira]

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.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.freedesktop.org/archives/libreoffice/attachments/20140610/bb775d3f/attachment.html>