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.
Context
- Can someone help me to changes my code? · Henokh Yudhistira
Privacy Policy |
Impressum (Legal Info) |
Copyright information: Unless otherwise specified, all text and images
on this website are licensed under the
Creative Commons Attribution-Share Alike 3.0 License.
This does not include the source code of LibreOffice, which is
licensed under the Mozilla Public License (
MPLv2).
"LibreOffice" and "The Document Foundation" are
registered trademarks of their corresponding registered owners or are
in actual use as trademarks in one or more countries. Their respective
logos and icons are also subject to international copyright laws. Use
thereof is explained in our
trademark policy.