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.
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.
EmoticonEmoticon