Aplikasi Pembayaran SPP VB 6.0

 

Program ini digunakan di setiap institusi pendidikan baik formal maupun non formal seperti di TK, SD, SMP, SMU, AMIK dan sekolah tinggi. Program ini dibuat sesimpel mungkin dengan mengakomidasi berbagai kebutuhan informasi yang diperlukan.

7.1 Merancang Database Dan Bentuk Relasi Tabel

Langkah awal yang harus dilakukan dalam pembuatan program Pembayaran SPP ini adalah :

1.              Membuat database dengan nama DBSPP.mdb. Bentuk relasi tabel dalam program Pembayaran SPP ini terlihat pada gambar di bawah ini :

7.2 Membuat Modul

Hal ini dibuat agar melakukan koneksi ke database cukup dengan memanggil nama prosedurnya saja. Lakukanlah langkah di bawah ini :

                Buka VB

                Klik menu project

                Pilih add module

                Klik open

                Kemudian ketiklah koding di bawah ini :

 

Public Conn As New ADODB.Connection

Public RSSPP As ADODB.Recordset

Public RSMAHASISWA As ADODB.Recordset

Public RSKASIR As ADODB.Recordset

 

Public Sub BukaDB()

Set Conn = New ADODB.Connection

Set RSSPP = New ADODB.Recordset

Set RSMAHASISWA = New ADODB.Recordset

Set RSKASIR = New ADODB.Recordset

Conn.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\DBSPP.mdb"

End Sub

7.3 Login

Setelah membuat module, buatlah form login kasir dengan bentuk seperti gambar di bawah ini.

7.4 Data mahasiswa

Setelah membuat form login kasir, buatlah form Mahasiswa dengan bentuk seperti gambar di bawah ini.

 

Proses dalam form ini adalah sebgaai berikut:

Input data dilakukan dengan memilih jurusan terlebih dahulu, jika jurusannya MI, maka program akan mencari berapa jumlah mahasiswa yang sudah mendaftar di jurusan MI, jika jumlah 0 5 maka dia termasuk kelas MI1A, jika 6 10 maka masuk ke kelas MI1B dan seterusnya. Dan proses input ini dibuat autonumber dengan pola nim YY99999. YY adalah tahun masuk 99 adalah jurusan (01 = MI, 02, KA dan 03 = TK), 999 adalah nomor urut. Adapun edit data cukup dengan mengetik NIM saja.

Koding :

Private Sub Form_Activate()

Call BukaDB

Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\DBSPP.mdb"

Adodc1.RecordSource = "MAHASISWA"

Adodc1.Refresh

Set DataGrid1.DataSource = Adodc1

DataGrid1.Refresh

'panggil prosedur untuk mengetahui jumlah siswa

Call JumlahMI

Call JumlahKA

Call JumlahTK

End Sub

 

Private Sub Form_Load()

Call BukaDB

Call KONDISIAWAL

TNIM.MaxLength = 7

Call ListJurusan

End Sub

 

Private Sub CBJurusan_KeyPress(Keyascii As Integer)

Keyascii = Asc(UCase(Chr(Keyascii)))

If Keyascii = 27 Then Unload Me

If Keyascii = 13 Then

If CBJurusan = "MI" Then

LBJurusan = "MANAJEMEN INFORMATIKA"

Call Nim_OTO_MI

Call KelasMI

ElseIf CBJurusan = "KA" Then

LBJurusan = "KOMPUTER AKUNTANSI"

Call Nim_OTO_KA

Call KelasKA

ElseIf CBJurusan = "TK" Then

LBJurusan = "TEKNIK KOMPUTER"

Call Nim_OTO_TK

Call KelasTK

End If

'jika jurusan bukan MI, KA atau TK, tampilkan pesan

TNIM.Enabled = False

If CBJurusan <> "MI" And CBJurusan <> "KA" And CBJurusan <> "TK" Then

MsgBox ("Jurusan tidak terdaftar, harusnya MI, KA atau TK")

CBJurusan.SetFocus

Exit Sub

Else

TNama.SetFocus

End If

End If

End Sub

 

Private Sub CBJurusan_Click()

If CBJurusan = "MI" Then

LBJurusan = "MANAJEMEN INFORMATIKA"

Call Nim_OTO_MI

Call KelasMI

ElseIf CBJurusan = "KA" Then

LBJurusan = "KOMPUTER AKUNTANSI"

Call Nim_OTO_KA

Call KelasKA

ElseIf CBJurusan = "TK" Then

LBJurusan = "TEKNIK KOMPUTER"

Call Nim_OTO_TK

Call KelasTK

End If

TNIM.Enabled = False

End Sub

 

Private Sub Command1_Click()

If Command1.Caption = "&Input" Then

Command1.Caption = "Simpan"

Command2.Enabled = False

Command3.Enabled = False

Command4.Caption = "&Batal"

Call Terang

CBJurusan.SetFocus

Exit Sub

Else

If CBJurusan = "" Or TNIM = "" Or TNama = "" Or LBKelas = "" Then

MsgBox "Data belum lengkap"

Exit Sub

Else

Dim aa As String

aa = "insert into MAHASISWA(NIM,NAMA,KELAS,JURUSAN) values ('" & TNIM & "','" & TNama & "','" & LBKelas & "','" & LBJurusan & "')"

Conn.Execute aa

Adodc1.Refresh

DataGrid1.Refresh

Call KONDISIAWAL

End If

End If

End Sub

 

Private Sub Command2_Click()

If Command2.Caption = "&Edit" Then

Command2.Caption = "Simpan"

Command1.Enabled = False

Command3.Enabled = False

Command4.Caption = "&Batal"

Call Terang

TNIM.SetFocus

Exit Sub

Else

If TNIM = "" Or TNama = "" Then

MsgBox "Data belum lengkap"

Exit Sub

Else

Dim cc As String

cc = "Update MAHASISWA set NAMA='" & TNama & "' where nim='" & TNIM & "'"

Conn.Execute cc

Call KONDISIAWAL

Adodc1.Refresh

DataGrid1.Refresh

Command2.SetFocus

Call KONDISIAWAL

End If

End If

End Sub

 

Private Sub Command3_Click()

If Command3.Caption = "&Hapus" Then

Command1.Enabled = False

Command2.Enabled = False

Command3.Caption = "&Hapus"

Command4.Caption = "&Batal"

TNIM.Enabled = True

TNIM.SetFocus

End If

End Sub

 

Private Sub Command4_Click()

Select Case Command4.Caption

Case "&Tutup"

Unload Me

Case "&Batal"

Call KONDISIAWAL

End Select

End Sub

 

'mengatur kelas sebanyak 5 orang untuk jurusan MI

'1-5 kelas MI-A, 6-10 kelas MI-B dan seterusnya

 

Sub KelasMI()

If Val(LBMI) < 5 And CBJurusan = "MI" Then

LBKelas = "MI1A"

ElseIf Val(LBMI) = 5 And CBJurusan = "MI" Then

LBKelas = "MI1B"

ElseIf Val(LBMI) >= 6 And Val(LBMI) < 10 And CBJurusan = "MI" Then

LBKelas = "MI1B"

ElseIf Val(LBMI) = 10 And CBJurusan = "MI" Then

LBKelas = "MI1C"

ElseIf Val(LBMI) > 10 And CBJurusan = "MI" Then

LBKelas = "MI1C"

End If

End Sub

 

Sub KelasKA()

If LBKA < 5 And CBJurusan = "KA" Then

LBKelas = "KA1A"

ElseIf LBKA = 5 And CBJurusan = "KA" Then

LBKelas = "KA1B"

ElseIf LBKA >= 6 And LBKA < 10 And CBJurusan = "KA" Then

LBKelas = "KA1B"

ElseIf LBKA = 10 And CBJurusan = "KA" Then

LBKelas = "KA1C"

ElseIf LBKA > 10 And CBJurusan = "KA" Then

LBKelas = "KA1C"

End If

End Sub

 

Sub KelasTK()

If LBTK < 5 And CBJurusan = "TK" Then

LBKelas = "TK1A"

ElseIf LBTK = 5 And CBJurusan = "TK" Then

LBKelas = "TK1B"

ElseIf LBTK >= 6 And LBTK < 10 And CBJurusan = "TK" Then

LBKelas = "TK1B"

ElseIf LBTK = 10 And CBJurusan = "TK" Then

LBKelas = "TK1C"

ElseIf LBTK > 10 And CBJurusan = "TK" Then

LBKelas = "TK1C"

End If

End Sub

 

'pengaturan pola NIM adalah YY01001

'nim akan bertambah otomatis pada tiga digit terakhirnya

'01 = MI (manajemen informatika)

'02 = KA (komputer akuntansi)

'03 = TK (teknik komputer)

 

Private Sub Nim_OTO_MI()

Call BukaDB

Dim RS As New ADODB.Recordset

RS.Open "select NIM from MAHASISWA where Jurusan='MANAJEMEN INFORMATIKA' order by nim desc", Conn

RS.Requery

If RS.EOF Then

Urutan = Format(Date, "YY") + "01" + "001"

TNIM = Urutan

Exit Sub

Else

Hitung = Right(RS!NIM, 3) + 1

Urutan = Format(Date, "YY") + "01" + Right("000" & Hitung, 3)

End If

TNIM = Urutan

End Sub

 

Sub Nim_OTO_KA()

Call BukaDB

Dim RS As New ADODB.Recordset

RS.Open "select NIM from MAHASISWA where Jurusan='KOMPUTER AKUNTANSI' order by nim desc", Conn

RS.Requery

If RS.EOF Then

Urutan = Format(Date, "YY") + "02" + "001"

TNIM = Urutan

Else

Hitung = Right(RS!NIM, 3) + 1

Urutan = Format(Date, "YY") + "02" + Right("000" & Hitung, 3)

End If

TNIM = Urutan

End Sub

 

Sub Nim_OTO_TK()

Call BukaDB

Dim RS As New ADODB.Recordset

RS.Open "select NIM from MAHASISWA where Jurusan='TEKNIK KOMPUTER' order by nim desc", Conn

RS.Requery

If RS.EOF Then

Urutan = Format(Date, "YY") + "03" + "001"

TNIM = Urutan

Else

Hitung = Right(RS!NIM, 3) + 1

Urutan = Format(Date, "YY") + "03" + Right("000" & Hitung, 3)

End If

TNIM = Urutan

End Sub

 

'prosedur untuk mencari jumlah total siswa di kelas MI

Function JumlahMI()

Dim RS As New ADODB.Recordset

RS.Open "select count(NIM) as JMLMI from MAHASISWA where jurusan='MANAJEMEN INFORMATIKA'", Conn

LBMI = RS!JMLMI

End Function

 

'prosedur untuk mencari jumlah total siswa di kelas MI

Function JumlahKA()

Dim RS As New ADODB.Recordset

RS.Open "select count(NIM) as JMLKA from MAHASISWA where jurusan='KOMPUTER AKUNTANSI'", Conn

LBKA = RS!JMLKA

End Function

 

'prosedur untuk mencari jumlah total siswa di kelas MI

Function JumlahTK()

Dim RS As New ADODB.Recordset

RS.Open "select count(NIM) as JMLTK from MAHASISWA where jurusan='TEKNIK KOMPUTER'", Conn

LBTK = RS!JMLTK

End Function

 

Sub ListJurusan()

CBJurusan.AddItem ("MI")

CBJurusan.AddItem ("KA")

CBJurusan.AddItem ("TK")

End Sub

 

Sub KONDISIAWAL()

Form_Activate

Call Gelap

Call KOSONGKAN

Call JumlahMI

Call JumlahKA

Call JumlahTK

Command1.Caption = "&Input"

Command2.Caption = "&Edit"

Command3.Caption = "&Hapus"

Command4.Caption = "&Tutup"

Command1.Enabled = True

Command2.Enabled = True

Command3.Enabled = True

Command4.Enabled = True

End Sub

 

Sub Tampilkan()

With RSMAHASISWA

CBJurusan = Left(!KELAS, 2)

TNama = !NAMA

LBKelas = !KELAS

LBJurusan = !JURUSAN

End With

End Sub

 

Private Sub TNama_KeyPress(Keyascii As Integer)

Keyascii = Asc(UCase(Chr(Keyascii)))

If Keyascii = 13 Then

If Command1.Enabled = True Then

Command1.SetFocus

Else

Command2.SetFocus

End If

End If

End Sub

 

Private Sub TNIM_KeyPress(Keyascii As Integer)

If Keyascii = 13 Then

If Len(TNIM) < 7 Then

MsgBox "NIM harus 7 digit"

TNIM.SetFocus

Exit Sub

End If

'untuk &Input

If Command1.Caption = "Simpan" Then

Call CariNIM

If Not RSMAHASISWA.EOF Then

Gelap

Tampilkan

MsgBox "Nomor MAHASISWA Sudah Ada"

KOSONGKAN

Terang

TNIM.SetFocus

Else

Terang

Gelap

TNama.SetFocus

End If

'untuk &Edit

ElseIf Command2.Caption = "Simpan" Then

Call CariNIM

If Not RSMAHASISWA.EOF Then

Tampilkan

Terang

TNIM.Enabled = False

TNama.SetFocus

Else

MsgBox "Nomor MAHASISWA Tidak Ditemukan"

KOSONGKAN

Terang

TNIM.SetFocus

End If

'untuk hapus

ElseIf Command3.Caption = "&Hapus" Then

With RSMAHASISWA

Call CariNIM

If Not RSMAHASISWA.EOF Then

Tampilkan

Gelap

Pesan = MsgBox("Yakin Data Ini Akan Dihapus...?", vbYesNo)

If Pesan = vbYes Then

Dim HapusMhs As String

HapusMhs = "delete * from mahasiswa where nim='" & TNIM & "'"

Conn.Execute (HapusMhs)

Adodc1.Refresh

DataGrid1.Refresh

KONDISIAWAL

Command3.SetFocus

Else

KONDISIAWAL

Command3.SetFocus

End If

Else

MsgBox "Nomor Formulir Tidak Ditemukan"

KOSONGKAN

Terang

TNIM.SetFocus

End If

End With

End If

End If

If Not (Keyascii >= Asc("0") And Keyascii <= Asc("9") Or Keyascii = vbKeyBack) Then Keyascii = 0

End Sub

 

Private Sub KOSONGKAN()

Dim Ctl As Control

For Each Ctl In Me

If TypeName(Ctl) = "TextBox" Or TypeName(Ctl) = "ComboBox" Then

Ctl.Text = ""

End If

Next

LBJurusan = ""

LBKelas = ""

End Sub

 

Private Sub Terang()

Dim Ctl As Control

For Each Ctl In Me

If TypeName(Ctl) = "TextBox" Or TypeName(Ctl) = "ComboBox" Then

Ctl.Enabled = True

End If

Next

End Sub

 

Private Sub Gelap()

Dim Ctl As Control

For Each Ctl In Me

If TypeName(Ctl) = "TextBox" Or TypeName(Ctl) = "ComboBox" Then

Ctl.Enabled = False

End If

Next

End Sub

 

Sub CariNIM()

Call BukaDB

RSMAHASISWA.Open "Select * From MAHASISWA where NIM='" & TNIM & "'", Conn

End Sub

 

7.5 Pembayaran SPP

Kemudian buatlah form untuk mengolah transaksi pembayaran SPP dengan bentuk seperti gambar di bawah ini :

 

Proses dalam form pembayaran SPP ini adalah sebgai berikut:

Input data dilakukan dengan memilih NIM dalam combo atau mengetiknya, jika siswa tersebut telah melakukan pembayaran maka akan tampil data pembayarannya dalam list, jika siswa tersebut belum bayar pada bulan yang bersangkutan maka setelah memilih NIM kursor akan menuju ke jumlah pembayaran. Jika jumlah pembayaran masih kosong dan data disimpan maka muncul pesan bahwa jumlah pembayaran masih kosong. Nomor pembayaran akan muncul secara otomatis. Jika pembayaran telah dilakukan maka akan tampil kwitansi pembayarannya yang telah dirancang dengan Crystal Report.

 

Koding :

'setiap kali form aktif.., tampilkan nim dan nama mahasiswa di combo nim

Private Sub Form_Activate()

Call BukaDB

RSMAHASISWA.Open "SELECT * FROM MAHASISWA ORDER BY 2", Conn

CBONIM.Clear

Do Until RSMAHASISWA.EOF

CBONIM.AddItem RSMAHASISWA!NIM & Space(10) & RSMAHASISWA!NAMA

RSMAHASISWA.MoveNext

Loop

'panggil prosedur pembuat nomor kwitansi otomatis

Call AUTONOMOR

End Sub

 

Private Sub Form_Load()

NOMOR.Visible = True

CARINOMOR.Visible = False

Call KOSONGKAN

CBONIM.Enabled = False

End Sub

 

Private Sub Dibayar_KeyPress(Keyascii As Integer)

If Keyascii = 13 Then

If DIBAYAR = "" Or Val(DIBAYAR) < (JUMLAH) Then

MsgBox "Jumlah Pembayaran Kurang"

DIBAYAR.SetFocus

Exit Sub

ElseIf Val(DIBAYAR) = JUMLAH Then

KEMBALI = 0

If CmdInput.Enabled = True Then CmdInput.SetFocus

If CmdEdit.Enabled = True Then CmdEdit.SetFocus

ElseIf Val(DIBAYAR) > JUMLAH Then

KEMBALI = DIBAYAR - JUMLAH

If CmdInput.Enabled = True Then CmdInput.SetFocus

If CmdEdit.Enabled = True Then CmdEdit.SetFocus

End If

End If

If Not (Keyascii >= Asc("0") And Keyascii <= Asc("9") Or Keyascii = vbKeyBack) Then Keyascii = 0

End Sub

 

'prosedur pembuat nomor kwitansi otomatis

Private Sub AUTONOMOR()

Call BukaDB

RSSPP.Open ("select * from SPP Where NOMOR In(Select Max(NOMOR)From SPP)Order By NOMOR Desc"), Conn

RSSPP.Requery

Dim Urutan As String * 9

Dim Hitung As Long

With RSSPP

If .EOF Then

Urutan = Format(Date, "YYMMDD") + "001"

NOMOR = Urutan

Else

If Left(!NOMOR, 6) <> Format(Date, "YYMMDD") Then

Urutan = Format(Date, "YYMMDD") + "001"

Else

Hitung = !NOMOR + 1

Urutan = Format(Date, "YYMMDD") + Right("000" & Hitung, 3)

End If

End If

NOMOR = Urutan

End With

End Sub

 

'prosedur untuk menampilkan data pembayawan berdasarkan nomor kwitansi

Private Sub CARINOMOR_KeyPress(Keyascii As Integer)

If Keyascii = 13 Then

Call BukaDB

Dim RSCARI As New ADODB.Recordset

RSCARI.Open "SELECT TANGGAL,MAHASISWA.NIM,NAMA,KELAS,JURUSAN,JUMLAH FROM SPP,MAHASISWA WHERE SPP.NIM=MAHASISWA.NIM AND NOMOR='" & CARINOMOR & "'", Conn

If Not RSCARI.EOF Then

TANGGAL = Format(RSCARI!TANGGAL, "DD-MMM-YYYY")

CBONIM = RSCARI!NIM

NAMA = RSCARI!NAMA

KELAS = RSCARI!KELAS

JURUSAN = RSCARI!JURUSAN

JUMLAH = RSCARI!JUMLAH

DIBAYAR.SetFocus

Exit Sub

Else

MsgBox "NOMOR KWITANSI TIDAK TERDAFTAR"

CARINOMOR.SetFocus

End If

End If

End Sub

 

Private Sub CmdInput_Click()

NOMOR.Visible = True

CARINOMOR.Visible = False

If CmdInput.Caption = "&Input" Then

CmdInput.Caption = "&Simpan"

CmdEdit.Enabled = False

CmdTutup.Caption = "&Batal"

Call KOSONGKAN

CBONIM.Enabled = True

CBONIM.SetFocus

Exit Sub

Else

If CBONIM = "" Or DIBAYAR = "" Then

MsgBox "DATA BELUM LENGKAP"

If CBONIM = "" Then

CBONIM.SetFocus

ElseIf JUMLAH = "" Then

DIBAYAR.SetFocus

End If

Else

Dim simpan As String

simpan = "insert into SPP(NOMOR,NIM,TANGGAL,JUMLAH,DIBAYAR,KEMBALI,KODEKSR,KET) VALUES ('" & NOMOR & "','" & Left(CBONIM, 7) & "','" & Date & "','" & JUMLAH & "','" & DIBAYAR & "','" & KEMBALI & "', '" & MENU.StatusBar1.Panels(1) & "', 'LUNAS')"

Conn.Execute simpan

Call KOSONGKAN

Call KONDISIAWAL

Form_Activate

'cetak kwitansi pembayaran yang telah dibuat dengan Crystal report

Call CETAKKWITANSI

End If

End If

End Sub

 

Private Sub CmdEdit_Click()

CARINOMOR.Visible = True

NOMOR.Visible = False

CBONIM.Enabled = False

If CmdEdit.Caption = "&Edit" Then

CmdInput.Enabled = False

CmdEdit.Caption = "&Simpan"

CmdTutup.Caption = "&Batal"

Call KOSONGKAN

CARINOMOR.SetFocus

Exit Sub

Else

Dim edit As String

edit = "UPDATE SPP SET DIBAYAR='" & DIBAYAR & "',KEMBALI='" & KEMBALI & "' WHERE NOMOR ='" & CARINOMOR & "'"

Conn.Execute edit

Call KOSONGKAN

Call KONDISIAWAL

NOMOR.Visible = True

CARINOMOR.Visible = False

Form_Activate

End If

End Sub

 

'prosedur untuk mencari data pembayaran berdasarkan nim

Private Sub CBONIM_keyPress(Keyascii As Integer)

Keyascii = Asc(UCase(Chr(Keyascii)))

If Keyascii = 13 Then

Call BukaDB

RSMAHASISWA.Open "Select * from MAHASISWA where NIm='" & Left(CBONIM, 7) & "'", Conn

If Not RSMAHASISWA.EOF Then

NAMA = RSMAHASISWA!NAMA

KELAS = RSMAHASISWA!KELAS

JURUSAN = RSMAHASISWA!JURUSAN

JUMLAH = 130000

Else

MsgBox " NIM TIDAK DITEMUKAN"

CBONIM.SetFocus

End If

RSSPP.Open "SELECT * FROM SPP WHERE NIM='" & Left(CBONIM, 7) & "' AND MONTH(TANGGAL) = '" & Month(Date) & "' AND YEAR(TANGGAL) = '" & Year(Date) & "'", Conn

If Not RSSPP.EOF Then

List1.Clear

Do While Not RSSPP.EOF

List1.AddItem RSSPP!TANGGAL & vbTab & "Rp " & Format(RSSPP!JUMLAH, "#,###,###")

RSSPP.MoveNext

Loop

MsgBox "NIM :" & Left(CBONIM, 7) & "" & Chr(13) & _

"NAMA :" & NAMA & "" & Chr(13) & _

"BULAN INI TELAH LUNAS"

Call KOSONGKAN

List1.Clear

Else

DIBAYAR = ""

DIBAYAR.SetFocus

End If

 

End If

End Sub

 

'proses sama dengan bagian di atas, bedanya nim tinggal dipilih

Private Sub CBONIM_Click()

Call BukaDB

RSMAHASISWA.Open "Select * from MAHASISWA where NIm='" & Left(CBONIM, 7) & "'", Conn

If Not RSMAHASISWA.EOF Then

NAMA = RSMAHASISWA!NAMA

KELAS = RSMAHASISWA!KELAS

JURUSAN = RSMAHASISWA!JURUSAN

JUMLAH = 130000

Else

MsgBox " NIM TIDAK DITEMUKAN"

CBONIM.SetFocus

End If

RSSPP.Open "SELECT * FROM SPP WHERE NIM='" & Left(CBONIM, 7) & "' AND MONTH(TANGGAL) = '" & Month(Date) & "' AND YEAR(TANGGAL) = '" & Year(Date) & "'", Conn

If Not RSSPP.EOF Then

List1.Clear

Do While Not RSSPP.EOF

List1.AddItem RSSPP!TANGGAL & vbTab & "Rp " & Format(RSSPP!JUMLAH, "#,###,###")

RSSPP.MoveNext

Loop

MsgBox "NIM :" & Left(CBONIM, 7) & "" & Chr(13) & _

"NAMA :" & NAMA & "" & Chr(13) & _

"BULAN INI TELAH LUNAS"

Call KOSONGKAN

List1.Clear

Else

DIBAYAR = ""

DIBAYAR.SetFocus

End If

 

End Sub

 

 

Sub KOSONGKAN()

NAMA = ""

KELAS = ""

JURUSAN = ""

JUMLAH = ""

CARINOMOR = ""

DIBAYAR = ""

KEMBALI = ""

JUMLAH = ""

End Sub

 

Sub KONDISIAWAL()

CBONIM.Enabled = False

CmdInput.Caption = "&Input"

CmdEdit.Caption = "&Edit"

CmdTutup.Caption = "&Tutup"

CmdInput.Enabled = True

CmdEdit.Enabled = True

End Sub

 

 

Private Sub CmdTutup_Click()

If CmdTutup.Caption = "&Tutup" Then

Unload Me

Else

NOMOR.Visible = True

CARINOMOR.Visible = False

Call KOSONGKAN

CBONIM.Enabled = False

CmdInput.Caption = "&Input"

CmdEdit.Caption = "&Edit"

CmdTutup.Caption = "&Tutup"

CmdInput.Enabled = True

CmdEdit.Enabled = True

CBONIM = ""

End If

End Sub

 

 

Sub CETAKKWITANSI()

CR.ReportFileName = App.Path & "\KWITANSI.rpt"

CR.WindowState = crptMaximized

CR.RetrieveDataFiles

CR.Action = 1

End Sub

 

7.6 Mencari Data Tunggakan

Proses selanjutnya adalah mencari data tunggakan. Proses dalam program ini adalah sebagai berikut :

Tahap awal adalah memilih bulan dan tahun berapa data tunggakan yang akan ditampilkan. Jika bulan dan tahun tunggakan lebih besar dari bulan dan tahun sekarang, maka akan tampil pesan bahwa tunggakan bulan tersebut tidak dapat diproses. Jika bulan dan tahun tunggakan lebih kecil dari tanggal sekarang maka secara otomatis tgl akhir pembayarannya adalah tanggal 5 bulan tersebut. Jika tanggal akhir pembayaran lebih kecil dari tanggal saat ini maka proses tunggakanpun tidak dapat diproses.

Jika pilihan tunggakan sudah sesuai persyaratan maka klik command tampilkan data tunggakan, setelah itu grid akan menampilkan datanya. Untuk menyimpan data tersbut klik command simpan data tunggakan. Jika data tunggakan pada bulan dan tahun yang sama disimpan dua kali, maka akan tampil pesan.

Koding :

Private Sub Form_Load()

TGLSEKARANG = Date

Call BukaDB

Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\DBSPP.mdb"

Adodc1.RecordSource = "TRTUNGGAKAN"

Adodc1.Refresh

Set DataGrid1.DataSource = Adodc1

DataGrid1.Refresh

Call Tabel_Kosong

End Sub

 

Private Sub Command1_Click()

'tgl akhir pembayaran ditentukan tgl 5 setiap bulannya

TGLAKHIR = "05" + "/" + Mid(BLNTUNGGAKAN, 4, 2) + "/" + Right(BLNTUNGGAKAN, 2)

'jika tgl akhir pembayarn > dari tanggal saat ini, maka tampilkan pesan

If CDate(TGLAKHIR) > CDate(TGLSEKARANG) Then

Call Tabel_Kosong

MsgBox "TUNGGAKAN BULAN " & Format(TGLAKHIR, "MMMM") & " TAHUN " & Format(TGLAKHIR, "YYYY") & " TIDAK DAPAT DIPROSES" & Chr(13) & _

"CARI BULAN DAN TAHUN YANG LEBIH KECIL DARI BULAN DAN TAHUN HARI INI"

BLNTUNGGAKAN.SetFocus

Exit Sub

Else

'jika tgl akhir lebih kecil dari gl sekarang, maka lakupan proses pencarian tunggakan

Call BukaDB

Dim RSCARI1 As New ADODB.Recordset

'cari data di tabel mahasiswa dan spp yang nim di di tabel mahasiswa tidak ada di tabel spp

'dan bulannya lebih kecil dari tgl akhir pembayaran

RSCARI1.Open "SELECT DISTINCT MAHASISWA.NIM,NAMA,TANGGAL FROM MAHASISWA,SPP WHERE MAHASISWA.NIM NOT IN " & _

"(SELECT NIM FROM SPP WHERE MONTH(TANGGAL) <=CDATE(MONTH('" & TGLAKHIR & "')))", Conn

'jika data ditemukan maka tampilkan dalam grid

If Not RSCARI1.EOF Then

Call Tabel_Kosong

RSCARI1.MoveFirst

NOMOR = 0

Do While Not RSCARI1.EOF

NOMOR = NOMOR + 1

Adodc1.Recordset.AddNew

Adodc1.Recordset!NO = NOMOR

Adodc1.Recordset!NIM = RSCARI1!NIM

Adodc1.Recordset!NAMA = RSCARI1!NAMA

Adodc1.Recordset!BULAN = TGLAKHIR

Adodc1.Recordset!JUMLAH = 130000

Adodc1.Recordset.Update

RSCARI1.MoveNext

Loop

Adodc1.Recordset.MoveFirst

Conn.Close

Else

'jika data tidak ditemukan, maka ambil datanya langsung dari tabel mahasiswa dan tampilkan dalam grid

Call BukaDB

Dim RSCARI2 As New ADODB.Recordset

RSCARI2.Open "SELECT MAHASISWA.NIM,NAMA FROM MAHASISWA ", Conn

Call Tabel_Kosong

RSCARI2.MoveFirst

NOMOR = 0

Do While Not RSCARI2.EOF

NOMOR = NOMOR + 1

Adodc1.Recordset.AddNew

Adodc1.Recordset!NO = NOMOR

Adodc1.Recordset!NIM = RSCARI2!NIM

Adodc1.Recordset!NAMA = RSCARI2!NAMA

Adodc1.Recordset!BULAN = TGLAKHIR

Adodc1.Recordset!JUMLAH = 130000

Adodc1.Recordset.Update

RSCARI2.MoveNext

Loop

Adodc1.Recordset.MoveFirst

End If

End If

'Text1 = Adodc1.Recordset.RecordCount & " ORANG"

End Sub

 

Private Sub Command1_KeyPress(Keyascii As Integer)

If Keyascii = 27 Then Unload Me

End Sub

 

'jika datagrid masih kosong, kemudian coba disimpan

'maka tampilkan pesan bahwa data tidak dapat disimpan

Private Sub Command2_Click()

If Adodc1.Recordset.RecordCount = 0 Then

MsgBox "TIDAK ADA DATA YANG DAPAT DISIMPAN" & Chr(13) & _

"PILIH BULAN DAN TAHUN YANG BENAR"

BLNTUNGGAKAN.SetFocus

Exit Sub

Else

'jika data dalam grid tampil, maka

Call BukaDB

'cari data yang bulan dan tahun tunggakannya sama dengan bulan dan tahun tgl akhir pembayaran

RSTUNGGAKAN.Open "SELECT * FROM TUNGGAKAN WHERE MONTH(BULAN)=MONTH('" & TGLAKHIR & "') AND YEAR(BULAN)=YEAR('" & TGLAKHIR & "')", Conn

'jika data tidak ditemukan maka simpan data dalam grid ke tabel tunggakan

If RSTUNGGAKAN.EOF Then

Adodc1.Recordset.MoveFirst

Do While Not Adodc1.Recordset.EOF

Dim SIMPANTUNGGAKAN As String

SIMPANTUNGGAKAN = "INSERT INTO TUNGGAKAN(NIM,NAMA,BULAN,JUMLAH) VALUES " & _

"('" & Adodc1.Recordset!NIM & "','" & Adodc1.Recordset!NAMA & "','" & TGLAKHIR & "','" & Adodc1.Recordset!JUMLAH & "')"

Conn.Execute SIMPANTUNGGAKAN

Adodc1.Recordset.MoveNext

Loop

Call Tabel_Kosong

MsgBox "DATA TELAH BERHASIL DISIMPAN"

Else

'jika data telah ada, maka tampilkan pesan bahwa data telah disimpan sebelumnya

MsgBox "DATA TELAH DISIMPAN SEBELUMNYA"

Call Tabel_Kosong

End If

End If

End Sub

 

'prosedur untuk mengosongkan tabel transaksi

Function Tabel_Kosong()

If Adodc1.Recordset.RecordCount > 0 Then

Adodc1.Recordset.MoveFirst

Do While Not Adodc1.Recordset.EOF

Adodc1.Recordset.Delete

Adodc1.Recordset.MoveNext

Loop

End If

End Function

7.7       Pembayaran Tunggakan

Setelah pencarian tunggakan SPP dilakukan, langkah selanjutnya adalah proses pembayaran tunggakan. Pola program ini hampir sama dengan pembayaran SPP sebelumnya. Buatlah form dengan bentuk seperti gambar di bawah ini.

Koding :

'setiap kali form aktif.., tampilkan nim dan nama mahasiswa di combo nim

Private Sub Form_Activate()

Call BukaDB

Dim RSCARI As New ADODB.Recordset

RSCARI.Open "SELECT DISTINCT NIM,NAMA FROM TUNGGAKAN", Conn

CBONIM.Clear

Do Until RSCARI.EOF

CBONIM.AddItem RSCARI!NIM & Space(10) & RSCARI!NAMA

RSCARI.MoveNext

Loop

 

'panggil prosedur pembuat nomor kwitansi otomatis

Call AUTONOMOR

End Sub

 

'objek nomor dan carinomor bertumpuk di satu posisi

Private Sub Form_Load()

NOMOR.Visible = True

CARINOMOR.Visible = False

TANGGAL = Format(Date, "DD-MMM-YYYY")

Call KOSONGKAN

CBONIM.Enabled = False

End Sub

 

'prosedur pembuat nomor kwitansi otomatis

Private Sub AUTONOMOR()

Call BukaDB

RSSPP.Open ("select * from SPP Where NOMOR In(Select Max(NOMOR)From SPP)Order By NOMOR Desc"), Conn

RSSPP.Requery

Dim Urutan As String * 9

Dim Hitung As Long

With RSSPP

If .EOF Then

Urutan = Format(Date, "YYMMDD") + "001"

NOMOR = Urutan

Else

If Left(!NOMOR, 6) <> Format(Date, "YYMMDD") Then

Urutan = Format(Date, "YYMMDD") + "001"

Else

Hitung = !NOMOR + 1

Urutan = Format(Date, "YYMMDD") + Right("000" & Hitung, 3)

End If

End If

NOMOR = Urutan

End With

End Sub

 

'prosedur untuk menampilkan data pembayawan berdasarkan nomor kwitansi

Private Sub CARINOMOR_KeyPress(Keyascii As Integer)

If Keyascii = 13 Then

Call BukaDB

Dim RSCARI As New ADODB.Recordset

RSCARI.Open "SELECT TANGGAL,MAHASISWA.NIM,NAMA,KELAS,JURUSAN,JUMLAH FROM SPP,MAHASISWA WHERE SPP.NIM=MAHASISWA.NIM AND NOMOR='" & CARINOMOR & "'", Conn

If Not RSCARI.EOF Then

TANGGAL = Format(RSCARI!TANGGAL, "DD-MMM-YYYY")

CBONIM = RSCARI!NIM

NAMA = RSCARI!NAMA

KELAS = RSCARI!KELAS

JURUSAN = RSCARI!JURUSAN

JUMLAH = RSCARI!JUMLAH

JUMLAH.SetFocus

Exit Sub

Else

MsgBox "NOMOR KWITANSI TIDAK TERDAFTAR"

CARINOMOR.SetFocus

End If

End If

End Sub

 

Private Sub CmdInput_Click()

NOMOR.Visible = True

CARINOMOR.Visible = False

If CmdInput.Caption = "&Input" Then

CmdInput.Caption = "&Simpan"

CmdEdit.Enabled = False

CmdTutup.Caption = "&Batal"

Call KOSONGKAN

CBONIM.Enabled = True

CBONIM.SetFocus

Exit Sub

Else

If CBONIM = "" Or DIBAYAR = "" Then

MsgBox "DATA BELUM LENGKAP"

If CBONIM = "" Then

CBONIM.SetFocus

ElseIf DIBAYAR = "" Then

DIBAYAR.SetFocus

End If

Else

Dim simpan As String

simpan = "insert into SPP(NOMOR,NIM,TANGGAL,JUMLAH,DIBAYAR,KEMBALI,KODEKSR,KET) VALUES " & _

"('" & NOMOR & "','" & Left(CBONIM, 7) & "','" & Date & "','" & JUMLAH & "','" & DIBAYAR & "','" & KEMBALI & "', '" & MENU.StatusBar1.Panels(1) & "', 'BAYAR TUNGGAKAN BULAN " & Left(List1, 8) & "')"

Conn.Execute simpan

 

Dim HAPUSTUNGGAKAN As String

HAPUSTUNGGAKAN = "DELETE * FROM TUNGGAKAN WHERE NIM='" & Left(CBONIM, 7) & "' AND CDATE(BULAN)='" & Left(List1, 8) & "'"

Conn.Execute HAPUSTUNGGAKAN

 

Call KOSONGKAN

Call KONDISIAWAL

List1.Clear

Form_Activate

'cetak kwitansi pembayaran yang telah dibuat dengan Crystal report

Call CETAKKWITANSI

End If

End If

End Sub

 

Private Sub CmdEdit_Click()

CARINOMOR.Visible = True

NOMOR.Visible = False

CBONIM.Enabled = False

If CmdEdit.Caption = "&Edit" Then

CmdInput.Enabled = False

CmdEdit.Caption = "&Simpan"

CmdTutup.Caption = "&Batal"

Call KOSONGKAN

CARINOMOR.SetFocus

Exit Sub

Else

Dim edit As String

edit = "UPDATE SPP SET JUMLAH='" & JUMLAH & "' WHERE NOMOR ='" & CARINOMOR & "'"

Conn.Execute edit

Call KOSONGKAN

Call KONDISIAWAL

NOMOR.Visible = True

CARINOMOR.Visible = False

Form_Activate

End If

End Sub

 

'prosedur untuk mencari data pembayaran berdasarkan nim

Private Sub CBONIM_keyPress(Keyascii As Integer)

Keyascii = Asc(UCase(Chr(Keyascii)))

If Keyascii = 13 Then

Call BukaDB

'cari data mahasiswa yang nimnya di ketik di cbonim

RSMAHASISWA.Open "Select * from MAHASISWA where NIm='" & Left(CBONIM, 7) & "'", Conn

If Not RSMAHASISWA.EOF Then

NAMA = RSMAHASISWA!NAMA

KELAS = RSMAHASISWA!KELAS

JURUSAN = RSMAHASISWA!JURUSAN

Else

MsgBox " NIM TIDAK DITEMUKAN"

CBONIM.SetFocus

Exit Sub

End If

'cari data spp berdasarkan NIM dan bulan sekarang berikut bulan sebelumnya

RSSPP.Open "SELECT * FROM SPP WHERE NIM='" & Left(CBONIM, 7) & "' AND MONTH(TANGGAL) <= '" & Month(TANGGAL) & "'", Conn

'jika data ditemukan, maka

If Not RSSPP.EOF Then

List1.Clear

'tampilkan data spp tersebut dalam list

Do While Not RSSPP.EOF

List1.AddItem RSSPP!TANGGAL & vbTab & "Rp " & Format(RSSPP!JUMLAH, "#,###,###")

RSSPP.MoveNext

Loop

'dan tampilkan pesan bahwa spp sudahlunas

MsgBox "NIM '" & Left(CBONIM, 7) & "' DENGAN NAMA '" & NAMA & "' BULAN INI TELAH LUNAS"

Call KOSONGKAN

List1.Clear

'CBONIM = ""

JUMLAH = ""

Else

'jika data tidak ditemukan, lakukan pembayaran di objek jumlah

JUMLAH = ""

JUMLAH.SetFocus

End If

 

End If

End Sub

 

'proses sama dengan bagian di atas, bedanya nim tinggal dipilih

Private Sub CBONIM_Click()

Call BukaDB

RSMAHASISWA.Open "Select * from MAHASISWA where NIm='" & Left(CBONIM, 7) & "'", Conn

If Not RSMAHASISWA.EOF Then

NAMA = RSMAHASISWA!NAMA

KELAS = RSMAHASISWA!KELAS

JURUSAN = RSMAHASISWA!JURUSAN

JUMLAH=130000

Else

MsgBox " NIM TIDAK DITEMUKAN"

CBONIM.SetFocus

End If

RSTUNGGAKAN.Open "SELECT DISTINCT BULAN,JUMLAH FROM TUNGGAKAN WHERE NIM='" & Left(CBONIM, 7) & "'", Conn

If Not RSTUNGGAKAN.EOF Then

List1.Clear

Do While Not RSTUNGGAKAN.EOF

List1.AddItem RSTUNGGAKAN!BULAN & vbTab & "Rp " & Format(RSTUNGGAKAN!JUMLAH, "#,###,###")

RSTUNGGAKAN.MoveNext

Loop

DIBAYAR = ""

Else

DIBAYAR = ""

DIBAYAR.SetFocus

End If

End Sub

 

Private Sub Dibayar_KeyPress(Keyascii As Integer)

If Keyascii = 13 Then

If DIBAYAR = "" Or Val(DIBAYAR) < (JUMLAH) Then

MsgBox "Jumlah Pembayaran Kurang"

DIBAYAR.SetFocus

Exit Sub

ElseIf Val(DIBAYAR) = JUMLAH Then

KEMBALI = 0

If CmdInput.Enabled = True Then CmdInput.SetFocus

If CmdEdit.Enabled = True Then CmdEdit.SetFocus

ElseIf Val(DIBAYAR) > JUMLAH Then

KEMBALI = DIBAYAR - JUMLAH

If CmdInput.Enabled = True Then CmdInput.SetFocus

If CmdEdit.Enabled = True Then CmdEdit.SetFocus

End If

End If

If Not (Keyascii >= Asc("0") And Keyascii <= Asc("9") Or Keyascii = vbKeyBack) Then Keyascii = 0

End Sub

 

Sub KOSONGKAN()

CBONIM.Text = "PILIH ATAU KETIK NIM DISINI"

NAMA = ""

KELAS = ""

JURUSAN = ""

JUMLAH = ""

CARINOMOR = ""

DIBAYAR = ""

KEMBALI = ""

End Sub

 

Sub KONDISIAWAL()

CmdInput.Caption = "&Input"

CmdEdit.Caption = "&Edit"

CmdTutup.Caption = "&Tutup"

CmdInput.Enabled = True

CmdEdit.Enabled = True

End Sub

 

Private Sub CmdTutup_Click()

If CmdTutup.Caption = "&Tutup" Then

Unload Me

Else

NOMOR.Visible = True

CARINOMOR.Visible = False

Call KOSONGKAN

List1.Clear

CBONIM.Enabled = False

CmdInput.Caption = "&Input"

CmdEdit.Caption = "&Edit"

CmdTutup.Caption = "&Tutup"

CmdInput.Enabled = True

CmdEdit.Enabled = True

CBONIM = ""

End If

End Sub

 

 

Sub CETAKKWITANSI()

CR.ReportFileName = App.Path & "\KWITANSI.rpt"

CR.WindowState = crptMaximized

CR.RetrieveDataFiles

CR.Action = 1

End Sub

 

Private Sub List1_Click()

Call BukaDB

RSSPP.Open "SELECT * FROM SPP WHERE NIM='" & Left(CBONIM, 7) & "' AND MONTH(TANGGAL)='" & Month(Left(List1, 8)) & "'", Conn

If Not RSSPP.EOF Then

MsgBox "DATA BULAN TSB TELAH LUNAS"

JUMLAH = ""

List1.SetFocus

Exit Sub

Else

JUMLAH = Right(List1, 7)

DIBAYAR.SetFocus

End If

End Sub

7.8 Pembuatan Laporan

7.8.1 Laporan SPP per nim dan per kelas

Setelah proses pembayaran SPP, pencarian tunggakan dan pembayaran tunggakan selesai, langkah berikutnya adalah membuat laporan. Laporan pertama adalah laporan pembayaran SPP berdasarkan NIM dan berdasarkan kelas. Buatlah form dengan bentuk seperti gambar di bawah ini.

Koding :

Private Sub Form_Load()

Call BukaDB

RSSPP.Open "Select Distinct NIM From SPP order By 1", Conn

RSSPP.Requery

Do Until RSSPP.EOF

Combo1.AddItem RSSPP!NIM

RSSPP.MoveNext

Loop

 

Dim RSTHN As New ADODB.Recordset

RSTHN.Open "select distinct year(TANGGAL) as Tahun from SPP", Conn

Do While Not RSTHN.EOF

Combo2.AddItem RSTHN!Tahun

Combo4.AddItem RSTHN!Tahun

RSTHN.MoveNext

Loop

 

RSMAHASISWA.Open "Select Distinct KELAS FROM MAHASISWA order By 1", Conn

RSMAHASISWA.Requery

Do Until RSMAHASISWA.EOF

Combo3.AddItem RSMAHASISWA!KELAS

RSMAHASISWA.MoveNext

Loop

Conn.Close

End Sub

 

Private Sub Command1_Click()

Call BukaDB

RSSPP.Open "SELECT * FROM SPP WHERE NIM='" & Combo1 & "' AND YEAR(TANGGAL)='" & Combo2 & "'", Conn

If RSSPP.EOF Then

MsgBox "DATA TIDAK DITEMUKAN"

Exit Sub

Else

CR.SelectionFormula = "{SPP.NIM}='" & Combo1 & "' and Year({SPP.TANGGAL})=" & Val(Combo2.Text)

CR.ReportFileName = App.Path & "\Lap spp per nim.rpt"

CR.WindowState = crptMaximized

CR.RetrieveDataFiles

CR.Action = 1

End If

End Sub

 

Private Sub Command2_Click()

Call BukaDB

RSSPP.Open "SELECT KELAS,TANGGAL FROM MAHASISWA,SPP WHERE MAHASISWA.NIM=SPP.NIM AND KELAS='" & Combo3 & "' AND YEAR(TANGGAL)='" & Combo4 & "'", Conn

If RSSPP.EOF Then

MsgBox "DATA TIDAK DITEMUKAN"

Exit Sub

Else

CR.SelectionFormula = "{MAHASISWA.KELAS}='" & Combo3 & "' and Year({SPP.TANGGAL})=" & Val(Combo4.Text)

CR.ReportFileName = App.Path & "\Lap spp per KELAS.rpt"

CR.WindowState = crptMaximized

CR.RetrieveDataFiles

CR.Action = 1

End If

End Sub

 

Hasil laporan terlihat pada gambar di bawah ini.

7.8.2 Laporan SPP Per Hari, Per Minggu Dan Per Bulan

Laporan berikutnya adalah laporan pembayaran SPP berkala (harian, mingguan dan bulanan), untuk itu buatlah form dengan bentuk seperti gambar di bawah ini. Laporan inilah yang paling sering diminta oleh pihak-pihak yang terkait.

Koding :

Private Sub Form_Load()

Call BukaDB

RSSPP.Open "Select Distinct TANGGAL From SPP order By 1", Conn

RSSPP.Requery

Do Until RSSPP.EOF

Combo1.AddItem Format(RSSPP!TANGGAL, "DD-MMM-YYYY")

Combo2.AddItem Format(RSSPP!TANGGAL, "YYYY ,MM, DD")

Combo3.AddItem Format(RSSPP!TANGGAL, "YYYY ,MM, DD")

RSSPP.MoveNext

Loop

Conn.Close

 

Call BukaDB

Dim RSTGL As New ADODB.Recordset

RSTGL.Open "select distinct month(TANGGAL) as Bulan from SPP", Conn

Do While Not RSTGL.EOF

Combo4.AddItem RSTGL!BULAN & Space(5) & MonthName(RSTGL!BULAN)

RSTGL.MoveNext

Loop

Conn.Close

 

Call BukaDB

Dim RSTHN As New ADODB.Recordset

RSTHN.Open "select distinct year(TANGGAL) as Tahun from SPP", Conn

Do While Not RSTHN.EOF

Combo5.AddItem RSTHN!Tahun

RSTHN.MoveNext

Loop

Conn.Close

End Sub

 

Private Sub Command1_Click()

If Combo1 = "" Then

MsgBox "PILIH TANGGALNYA DULU..."

Exit Sub

Else

CR.SelectionFormula = "Totext({SPP.TANGGAL})='" & CDate(Combo1) & "'"

CR.ReportFileName = App.Path & "\Lap SPP Harian.rpt"

CR.WindowState = crptMaximized

CR.RetrieveDataFiles

CR.Action = 1

End If

End Sub

 

Private Sub Command2_Click()

If Combo2 = "" Or Combo3 = "" Then

MsgBox "PILIH TANGGAL AWAL DAN TANGGAL AKHIRNYA..."

Exit Sub

Else

CR.SelectionFormula = "{SPP.TANGGAL} in date (" & Combo2.Text & ") to date (" & Combo3.Text & ")"

CR.ReportFileName = App.Path & "\Lap SPP Mingguan.rpt"

CR.WindowState = crptMaximized

CR.RetrieveDataFiles

CR.Action = 1

End If

End Sub

 

Private Sub Command3_Click()

If Combo4 = "" Or Combo5 = "" Then

MsgBox "PILIH BULAN DAN TAHUNYA DULU..."

Exit Sub

Else

Call BukaDB

RSSPP.Open "select * from SPP where month(TANGGAL)='" & Val(Combo4) & "' and year(TANGGAL)='" & (Combo5) & "'", Conn

If RSSPP.EOF Then

MsgBox "Data tidak ditemukan"

Exit Sub

Combo4.SetFocus

End If

 

CR.SelectionFormula = "Month({SPP.TANGGAL})=" & Val(Combo4.Text) & " and Year({SPP.TANGGAL})=" & Val(Combo5.Text)

CR.ReportFileName = App.Path & "\Lap SPP Bulanan.rpt"

CR.WindowState = crptMaximized

CR.RetrieveDataFiles

CR.Action = 1

End If

End Sub

 

Hasil laporan berkala dapat dilihat pada beberapa gambar di bawah ini.

7.8.3 Laporan Tunggakan SPP

Hal yang tidak kalah pentingnya dalam pembuatan laporan adalah laporan tunggakan. Dalam hal ini laporan tunggakan dibagi dua bentuk yaitu laporan tunggakan per bulan dan per kelas. Buatlah form dengan bentuk seperti gambar di bawah ini.

Koding :

Private Sub Form_Load()

Call BukaDB

Dim RSBLN As New ADODB.Recordset

RSBLN.Open "select distinct MONTH(BULAN) as BLN from TUNGGAKAN", Conn

Do While Not RSBLN.EOF

Combo1.AddItem RSBLN!BLN

RSBLN.MoveNext

Loop

 

Dim RSTHN As New ADODB.Recordset

RSTHN.Open "select distinct year(BULAN) as Tahun from TUNGGAKAN", Conn

Do While Not RSTHN.EOF

Combo2.AddItem RSTHN!Tahun

Combo4.AddItem RSTHN!Tahun

RSTHN.MoveNext

Loop

 

RSMAHASISWA.Open "Select Distinct KELAS FROM MAHASISWA order By 1", Conn

RSMAHASISWA.Requery

Do Until RSMAHASISWA.EOF

Combo3.AddItem RSMAHASISWA!KELAS

RSMAHASISWA.MoveNext

Loop

Conn.Close

End Sub

 

 

Private Sub Command1_Click()

Call BukaDB

RSTUNGGAKAN.Open "select * from tunggakan where month(bulan)='" & Combo1 & "' and year (bulan)='" & Combo2 & "'", Conn

If RSTUNGGAKAN.EOF Then

MsgBox "DATA TIDAK DITEMUKAN"

Exit Sub

ElseIf Combo1 = "" Or Combo2 = "" Then

MsgBox "BULAN DAN TAHUN HARUS DIISI"

If Combo1 = "" Then

Combo1.SetFocus

ElseIf Combo2 = "" Then

Combo2.SetFocus

End If

Else

CR.SelectionFormula = "Month({TUNGGAKAN.BULAN})=" & Combo1 & " and Year({TUNGGAKAN.BULAN})=" & Combo2

CR.ReportFileName = App.Path & "\Lap TUNGGAKAN BLN.rpt"

CR.WindowState = crptMaximized

CR.RetrieveDataFiles

CR.Action = 1

End If

End Sub

 

Private Sub Command2_Click()

Call BukaDB

RSTUNGGAKAN.Open "SELECT KELAS,BULAN FROM MAHASISWA,TUNGGAKAN WHERE MAHASISWA.NIM=TUNGGAKAN.NIM AND KELAS='" & Combo3 & "' AND YEAR(BULAN)='" & Combo4 & "'", Conn

If RSTUNGGAKAN.EOF Then

MsgBox "DATA TIDAK DITEMUKAN"

Exit Sub

Else

CR.SelectionFormula = "YEAR({TUNGGAKAN.BULAN})=" & Val(Combo4) & " AND {MAHASISWA.KELAS}='" & Combo3 & "'"

CR.ReportFileName = App.Path & "\Lap TUNGGAKAN PER KELAS.rpt"

CR.WindowState = crptMaximized

CR.RetrieveDataFiles

CR.Action = 1

End If

End Sub

Hasil laporan tunggakan SPP dapat di lihat pada gambar di bawah ini.