Saturday, March 18, 2017

program aplikasi pembayaran spp vb 6

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.





EmoticonEmoticon