Program Pembayaran SPP

Langkah awal buat database dengan mana”DbSekolah.mdb” dengan 5 Tabel sebagi berikut:

 

Selanjutnya Butat form Pembayaran dengan rancangan sebagai berikut:

 

Tool yang digunakan adalah sebagai berikut Lihat table:

 

Kemudian Membuat Menunya dengam memilih menu  TOOL  kemudian pilih MenuEditor

 

 

Langkah selanjutnya adalah memasukkan kode programnya :

Option Explicit

Private koneksi As ADODB.Connection

Dim rstabel As New ADODB.Recordset

---

Private Function konek() As Boolean

    On Error GoTo out

        Set koneksi = New ADODB.Connection

        koneksi.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\DbSekolah.mdb;Persist Security Info=False"

        koneksi.CursorLocation = adUseClient

        konek = True

out:

End Function

---

Private Sub CmdLaporan_Click()

FrmData.Show

End Sub

---

Private Sub CmdRefrash_Click()

        TxtNIS.Text = ""

        TxtNama.Text = ""

        TxtAlamat.Text = ""

        TxtJurusan.Text = ""

        TxtProg.Text = ""

        TxtKelas.Text = ""

        TxtSPP.Text = "0"

        TxtPraktek.Text = "0"

        TxtOsis.Text = "0"

        TxtUjian.Text = "0"

        TxtLap.Text = "0"

        TxtAdm.Text = "0"

        TxtBeasiswa.Text = "0"

        TxtTotal.Text = "0"

        TxtBayar.Text = "0"

        TxtKembali.Text = "0"

End Sub

---

Private Sub CmdSimpan_Click()

With Adodc3.Recordset

.AddNew

.Fields("NIS") = TxtNIS.Text

.Fields("Nama") = TxtNama.Text

.Fields("Alamat") = TxtAlamat.Text

.Fields("Jurusan") = TxtJurusan.Text

.Fields("Program_Keahlian") = TxtProg.Text

.Fields("Kelas") = TxtKelas.Text

.Fields("SPP") = TxtSPP.Text

.Fields("Praktek") = TxtPraktek.Text

.Fields("Osis") = TxtOsis.Text

.Fields("Ujian") = TxtUjian.Text

.Fields("Praktek_Lapangan") = TxtLap.Text

.Fields("Administrasi") = TxtAdm.Text

.Fields("Beasiswa") = TxtBeasiswa.Text

.Fields("Total") = TxtTotal.Text

.Fields("Operator") = TxtOperator.Text

.Fields("Tanggal") = LbTgl.Caption

.Fields("Jam") = LbJam.Caption

End With

'Melaporkan jika sudah tersimpan

MsgBox "Data telah di Simpan!", vbInformation + vbOKOnly = vbIgnore

Call CmdRefrash_Click

End Sub

---

Private Sub Form_Activate()

‘memanggil  nama Operator dari table Aktifvitas Operator

      TxtOperator.Text = Adodc4.Recordset!Administrator

 Dim t$

    Dim thn$, bln$, tgl$

    t = MaskEdBox1.Text

    If t <> "__/__/__" Then

        thn = Right(t, 4)

        bln = Mid(t, 4, 2)

        tgl = Left(t, 2)

       

        If IsDate(thn & "-" & bln & "-" & tgl) = False Then

                 MaskEdBox1.Text = Format(Now, "dd/MM/yyyy")

                 LbTgl.Caption = MaskEdBox1.Text

        End If

    End If

End Sub

---

Private Sub Form_Load()

If Not konek() Then

        MsgBox "Gak bisa terhubung ke database!", vbCritical

        End

    End If

    Adodc1.ConnectionString = koneksi.ConnectionString

    Adodc1.RecordSource = "Siswa"

    Set DataGrid1.DataSource = Adodc1

    Adodc2.ConnectionString = koneksi.ConnectionString

    Adodc2.RecordSource = "Seting"

    Set DataGrid2.DataSource = Adodc2

    Adodc3.ConnectionString = koneksi.ConnectionString

    Adodc3.RecordSource = "Pembayaran"

    Set DataGrid3.DataSource = Adodc3

    Adodc4.ConnectionString = koneksi.ConnectionString

    Adodc4.RecordSource = "AktifvitasOP"

    Set DataGrid4.DataSource = Adodc4

End Sub

---

Private Sub nmAbout_Click()

FrmAbout.Show

End Sub

---

Private Sub nmdata_Click()

Unload Me

FrmSiswa.Show

End Sub

---

Private Sub nmdatasiswa_Click()

DataReportSiswa.Show

End Sub

---

Private Sub nmExit_Click()

If MsgBox("Yakin mau keluar?", vbQuestion + vbYesNo) = vbYes Then

        Unload Me

    End If

End Sub

---

Private Sub nmpembayaran_Click()

DataReportPembayaran.Show

End Sub

---

Private Sub nmsetadm_Click()

FrmAdmin.Show

End Sub

---

Private Sub snmsetnilai_Click()

FrmSeting.Show

End Sub

---

Private Sub Timer1_Timer()

Dim dblSecond As Double, dblMinute As Double, dblHour As Double

dblSecond = Second(Now) * 6 - 90

dblMinute = (Minute(Now) + Second(Now) / 60) * 6 - 90

dblHour = (Hour(Now) + Minute(Now) / 60) * 30 - 90

LbJam.Caption = Format(Now, "hh:mm:ss")

End Sub

---

Private Sub TxtAdm_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

TxtBeasiswa.SetFocus

End If

End Sub

---

Private Sub TxtBayar_Change()

TxtKembali = Val(TxtBayar.Text) - Val(TxtTotal)

End Sub

---

Private Sub TxtBayar_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

Call CmdSimpan_Click

End If

End Sub

---

Private Sub TxtBeasiswa_Change()

TxtTotal = (Val(TxtSPP.Text) + Val(TxtPraktek.Text) + Val(TxtOsis.Text) + Val(TxtUjian.Text) + Val(TxtLap.Text) + Val(TxtAdm.Text)) - Val(TxtBeasiswa)

End Sub

---

Private Sub TxtBeasiswa_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

TxtBayar.SetFocus

End If

End Sub

---

Private Sub TxtNIS_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

‘memanggil data dari table siswa

Adodc1.Recordset.Find "NIS='" + TxtNIS.Text + "'", , adSearchForward, 1

If Not Adodc1.Recordset.EOF Then

        TxtNama.Text = Adodc1.Recordset.Fields("Nama")

        TxtAlamat.Text = Adodc1.Recordset.Fields("Alamat")

        TxtJurusan.Text = Adodc1.Recordset.Fields("Jurusan")

        TxtProg.Text = Adodc1.Recordset.Fields("Keahlian")

        TxtKelas.Text = Adodc1.Recordset.Fields("Kelas")

'memanggil data dari tabel seting

    Adodc2.Recordset.Find "Progm_Keahlian='" + TxtProg.Text + "'", , adSearchForward, 1

    If Not Adodc2.Recordset.EOF Then

        TxtSPP.Text = Adodc2.Recordset!SPP

        TxtPraktek.Text = Adodc2.Recordset!Praktek

        TxtOsis.Text = Adodc2.Recordset!Osis

        TxtUjian.Text = Adodc2.Recordset!Ujian

        TxtLap.Text = Adodc2.Recordset!Praktek_Lap

        TxtAdm.Text = Adodc2.Recordset!Administrasi

        TxtBeasiswa.SetFocus

    Else

        MsgBox "Maaf, Seting Tidak Ditemukan!"

    End If

Else

     MsgBox "Maaf, Data Tidak Ditemukan!"

     TxtNIS.Text = ""

     TxtNIS.SetFocus

End If

TxtTotal = (Val(TxtSPP.Text) + Val(TxtPraktek.Text) + Val(TxtOsis.Text) + Val(TxtUjian.Text) + Val(TxtLap.Text) + Val(TxtAdm.Text))

End If

End Sub

 NEXT-->

Untuk mempelajarinya lebih dalah download projecnya:Pembayaran SPP.rar
download Updaten Project x  Pemabayaran SPP Update
 download tuturialnya di sini:Program Pembayaran SPP