Posts
Contoh Penggunaannya :
Option Explicit
Dim db As DAO.Database, DbMaster As DAO.Database, DbTmp As DAO.Database
Dim Rs As DAO.Recordset, RsSandi As DAO.Recordset, RsTmp As DAO.Recordset
Dim jJum1 As Currency, jJum2 As Currency, jJum3 As Currency, jJum4 As Currency, jJum5 As Currency, jJum6 As Currency, jJum7 As Currency
Dim mintFileNo As Integer
Dim mstrfilename As String
Dim mintpageno As Integer
Dim mintlineno As Integer
Dim CariR As String * 9
Private Sub CmdKeluar_Click()
boolDirty = False
Call RekamKegiatan(" Keluar dari menu : " & HrfJalan)
HrfJalan = "Aplikasi System Akuntansi"
Unload Me
End Sub
Private Sub CmdLayar_Click()
ReportViewer1.ShowPrintPreview
End Sub
Private Sub CmdPrinter_Click()
'Load Form36
Form36.Show
End Sub
Private Sub CmdProses_Click()
If Option1.Value = False And Option2.Value = False And Option3.Value = False And Option4.Value = False And Option5.Value = False Then
CInteraction.ShowMsgBox "Informasi", "Anda tidak memilih pilihan yang akan dicetak", , , , , imgExclamationEx, 1
Exit Sub
End If
Set db = OpenDatabase(App.Path & "\DATA\AKUN" & BDatabase & ".MDB", False, False, dbLangGeneral & ";pwd=newpassword")
Set Rs = db.OpenRecordset(Filedata & "B", dbOpenTable)
Rs.Index = "TANGGAL"
Set DbMaster = OpenDatabase(App.Path & "\DATA\AKUNTANSI.MDB", False, False, dbLangGeneral & ";pwd=newpassword")
Set RsSandi = DbMaster.OpenRecordset("AKNSANDI", dbOpenTable)
RsSandi.Index = "REKSANDI"
Call TabelSaldo
Set DbTmp = OpenDatabase(App.Path & "\DATA\TMPMDB.MDB", False, False, dbLangGeneral & ";pwd=newpassword")
Set RsTmp = DbTmp.OpenRecordset(Operator, dbOpenTable)
RsTmp.Index = "REBUKU"
jJum1 = 0: jJum2 = 0: jJum3 = 0: jJum4 = 0: jJum5 = 0: jJum6 = 0
'-----------------------
'sub-sub buku besar
'-----------------------
If Option3.Value = True Then
With RsTmp
If .RecordCount > 0 Then
.MoveFirst
Do While Not .EOF
.Delete
.MoveNext
Loop
End If
End With
With Rs
If .RecordCount < 1 Then
CInteraction.ShowMsgBox "Informasi", "Data masih kosong", , , , , 0, 1
Tutup
Exit Sub
End If
.MoveFirst
Do While Not .EOF
If Right(!rebuku, 2) <> "00" Then
With RsTmp
.AddNew
!rebuku = Rs!rebuku
.Update
End With
End If
.MoveNext
Loop
End With
With RsTmp
If .RecordCount < 1 Then
CInteraction.ShowMsgBox "Informasi", "Data masih kosong", , , , , 0, 1
Tutup
Exit Sub
End If
mstrfilename = App.Path & "\" & Operator & ".txt"
mintFileNo = 1
mintpageno = 1
Open mstrfilename For Output As #mintFileNo ' Open file for output.
.MoveFirst
If .RecordCount > 100 Then
PBar.Max = .RecordCount + 1
End If
putar = 0
Do While Not .EOF
CariR = !rebuku
Call ReportHeader
jJum1 = 0: jJum2 = 0: jJum3 = 0: jJum4 = 0: jJum5 = 0: jJum6 = 0
With Rs
.MoveFirst
Do While Not .EOF
If !rebuku = CariR Then
Print #mintFileNo, AlignValue(!tanggal, "L", 12);
Print #mintFileNo, AlignValue(" ", "L", 30);
Print #mintFileNo, AlignValue(Format(!saldoa, "#,##0.#0"), "R", 21);
Print #mintFileNo, AlignValue(Format(!dbkas, "#,##0.#0"), "R", 21);
Print #mintFileNo, AlignValue(Format(!kdkas, "#,##0.#0"), "R", 21);
Print #mintFileNo, AlignValue(Format(!dbmem, "#,##0.#0"), "R", 21);
Print #mintFileNo, AlignValue(Format(!kdmem, "#,##0.#0"), "R", 21);
Print #mintFileNo, AlignValue(Format(!Saldok, "#,##0.#0"), "R", 21)
jJum1 = jJum1 + !dbkas: jJum2 = jJum2 + !kdkas: jJum3 = jJum3 + !dbmem: jJum4 = jJum4 + !kdmem
mintlineno = mintlineno + 1
If mintlineno > 35 Then
Call ReportFother
Print #mintFileNo, Chr(12)
mintlineno = 0
mintpageno = mintpageno + 1
Call ReportHeader
End If
End If
Rs.MoveNext
Loop
Call ReportFother
End With
putar = putar + 1
PBar.Value = putar
.MoveNext
Loop
End With
Close #mintFileNo
ReportViewer1.ReportTitle = "Rekening Koran Buku Besar" ' Optional
ReportViewer1.FileName = mstrfilename 'Must Fields
'ReportViewer1.ShowPrintPreview ' To Show the Report
'Showing about form Optional
'ReportViewer1.ShowAboutDlg
Tutup
'CInteraction.ShowMsgBox "Informasi", "Proses selesai", , , , , 0, 1
CmdLayar.Enabled = True
CmdPrinter.Enabled = True
CmdProses.Enabled = False
Call RekamKegiatan(" Melihat : " & Option3.Caption)
End If
Private Sub ReportHeader()
Print #mintFileNo, Chr(27) + Chr(69);
Print #mintFileNo, AlignValue("REKENING KORAN", "C", 120)
Print #mintFileNo,
Print #mintFileNo, AlignValue("Rekening : " & CariR, "L", 30) & Space(2)
RsSandi.Seek "=", CariR
If Not RsSandi.NoMatch Then
Print #mintFileNo, AlignValue("Nama : " & RsSandi!nama, "L", 30) & Space(2)
Else
Print #mintFileNo, AlignValue("Nama : ", "L", 30) & Space(2)
End If
Print #mintFileNo, String(168, "=")
Print #mintFileNo, AlignValue(" ", "L", 63); AlignValue("MUTASI KAS", "C", 42); AlignValue("MUTASI MEMORIAL", "C", 42)
Print #mintFileNo, AlignValue("Tanggal", "C", 12); AlignValue("Keterangan", "C", 30); AlignValue("Saldo Awal", "C", 21);
Print #mintFileNo, String(84, "-"); AlignValue("Saldo Akhir", "C", 21)
Print #mintFileNo, AlignValue(" ", "L", 63); AlignValue("Debet", "C", 21); AlignValue("Kredit", "C", 21); AlignValue("Debet", "C", 21); AlignValue("Kredit", "C", 21)
Print #mintFileNo, String(168, "-");
Print #mintFileNo, Chr(27) + Chr(70)
mintlineno = mintlineno + 8
End Sub
Private Sub ReportFother()
Print #mintFileNo, String(168, "-")
Print #mintFileNo, AlignValue(" Jumlah ", "C", 63); AlignValue(Format(jJum1, "#,##0.#0"), "R", 21); AlignValue(Format(jJum2, "#,##0.#0"), "R", 21); AlignValue(Format(jJum3, "#,##0.#0"), "R", 21); AlignValue(Format(jJum4, "#,##0.#0"), "R", 21)
Print #mintFileNo, String(168, "-")
End Sub
Private Function RndNum(n As Integer) As Integer
Randomize n + Timer
RndNum = Int(Rnd * n)
End Function
Private Sub Form_Activate()
boolDirty = True
End Sub
Private Sub Form_Load()
Dim inghwnd As String
inghwnd = Me.hWnd
Call DisableClose(inghwnd)
Call RekamKegiatan(" Menjalankan menu : " & HrfJalan)
CmdLayar.Enabled = False
CmdPrinter.Enabled = False
CmdProses.Enabled = False
Form19.Left = Lebar / 2 - (Me.Width / 2)
Form19.Top = ((Tinggi / 2) - (Me.Height / 2))
Call DisableClose(inghwnd)
End Sub
Private Sub Option3_Click()
CmdLayar.Enabled = False
CmdPrinter.Enabled = False
CmdProses.Enabled = True
End Sub
Private Sub Option4_Click()
CmdLayar.Enabled = False
CmdPrinter.Enabled = False
CmdProses.Enabled = True
End Sub
Sub Tutup()
Rs.Close
Set Rs = Nothing
RsSandi.Close
Set RsSandi = Nothing
RsTmp.Close
Set RsTmp = Nothing
db.Close
Set db = Nothing
DbMaster.Close
Set DbMaster = Nothing
DbTmp.Close
Set DbTmp = Nothing
End Sub
0 komentar:
Komentar Anda
Berikan komentar..