Membuat aplikasi administrasi pembayaran spp sekolahpro

Untuk kali ini penulis akan mengajak vbthok mania untuk mencoba membuat program jadi "aplikasi pembayaran spp" yang berfungsi untuk menangani dan mencatat transaksi pembayaran spp pada sekolah, program ini juga menyediakan report yang berfungsi untuk membuat laporan transaksi yang sudah terjadi.Semoga dengan program ini para vbthok mania bisa mengaplikasikannya dan mengembangkan tentunya menjadi yang lebih bagus dan lengkap.

Berikut tampilan menu yang sudah jadi.


untuk component yang dibutuhkan adalah :

untuk yang missing activeskin 4.3 coba untuk melakukan install programnya activeskin kalau sudah cb jalankan lagi, tambahkan juga componen crystal report.

Untuk script codenya bisa dicontoh seperti dibawah ini
'code form1

Private Sub Command1_Click()
formSiswa.Show
End Sub

Private Sub Timer1_Timer()
Label1.ForeColor = QBColor(Rnd * 15)
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "siswa"
formSiswa.Show 1
Case "guru"
formGuru.Show
Case "transaksi"
frmspp.Show
Case "laporan"
frmcetakspp.Show
Case "keluar"
End
End Select
End Sub

'code form guru

Private Sub Command1_Click()
On Error Resume Next
CrystalReport1.WindowState = crptMaximized
CrystalReport1.RetrieveDataFiles
CrystalReport1.Action = 1
End Sub

Private Sub Form_Load()
Data1.DatabaseName = App.Path & "\spp.mdb"
Data1.RecordSource = "guru"
CrystalReport1.ReportFileName = App.Path & "\lapguru.rpt"
End Sub

Private Sub optlaki_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtTTL.SetFocus
End If
End Sub

Private Sub optper_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtTTL.SetFocus
End If
End Sub

Private Sub txtalamat_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
optlaki.SetFocus
End If
End Sub

Private Sub txtcarikode_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub

Private Sub txtjab_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtmengajar.SetFocus
End If
End Sub

Private Sub txtnama_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
txtalamat.SetFocus
End If
End Sub

Private Sub txtnip_Change()
Dim X As Byte
If Len(txtnip.Text) < 11 Then
Exit Sub
End If
txtnama.SetFocus
cmdsimpan.Enabled = True
Data1.Recordset.Index = "idx_nip"
Data1.Recordset.Seek "=", txtnip.Text
If Not Data1.Recordset.NoMatch Then
cmdupdate.Enabled = True
cmdsimpan.Enabled = False
tampil
Exit Sub
End If
End Sub

Private Sub txtnip_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub

Private Sub txtnip_LostFocus()

End Sub


Private Sub DBGrid1_DblClick()
txtnip.Text = DBGrid1.Text
End Sub

Private Function bersih()
txtnip.Text = ""
txtnama.Text = ""
txtalamat.Text = ""
txtTTL.Text = ""
txtjab.Text = ""
txtmengajar.Text = ""
optlaki.Value = False
optper.Value = False
End Function

Private Sub cmdbatal_Click()
bersih
cmdsimpan.Enabled = False
cmdupdate.Enabled = False
txtnip.Enabled = True
txtnip.SetFocus
End Sub

Private Function tampil()
txtnip.Enabled = False
txtnama.Text = Data1.Recordset!Nama
txtalamat.Text = Data1.Recordset!alamat
If Data1.Recordset!jk = "L" Then
optlaki.Value = True
Else
optper.Value = True
End If
txtTTL.Text = Data1.Recordset!ttl
txtjab.Text = Data1.Recordset!jabatan
txtmengajar.Text = Data1.Recordset!mengajar
cmdsimpan.Enabled = False
End Function

Private Sub cmdclose_Click()
formGuru.Hide
End Sub

Private Sub cmdhapus_Click()
On Error Resume Next
X = MsgBox("Data akan dihapus ? ", vbOKCancel, "PERHATIAN")
If X = vbOK Then
Data1.Recordset.Delete
bersih
End If
End Sub

Private Sub cmdsimpan_Click()
If txtnip.Text = "" Or txtnama.Text = "" Or txtalamat.Text = "" _
Or txtTTL.Text = "" Or txtjab.Text = "" Or txtmengajar.Text = "" _
Or (optlaki.Value = False And optper.Value = False) Then
MsgBox "Entry Data isn't complite..!!"
bersih
Exit Sub
Else
Data1.Recordset.AddNew
Data1.Recordset!nip = txtnip.Text
Data1.Recordset!Nama = txtnama.Text
Data1.Recordset!alamat = txtalamat
If optlaki.Value = True Then
Data1.Recordset!jk = "L"
Else
Data1.Recordset!jk = "P"
End If
Data1.Recordset!ttl = txtTTL.Text
Data1.Recordset!jabatan = txtjab.Text
Data1.Recordset!mengajar = txtmengajar.Text
Data1.Recordset.Update
bersih
cmdsimpan.Enabled = False
End If
End Sub

Private Sub cmdupdate_Click()
Data1.Recordset.Edit
Data1.Recordset!Nama = txtnama.Text
Data1.Recordset!alamat = txtalamat.Text
If optlaki.Value = True Then
Data1.Recordset!jk = "L"
Else
Data1.Recordset!jk = "P"
End If
Data1.Recordset!ttl = txtTTL.Text
Data1.Recordset!jabatan = txtjab.Text
Data1.Recordset!mengajar = txtmengajar.Text
Data1.Recordset.Update
bersih
cmdupdate.Enabled = False
cmdsimpan.Enabled = True
txtnip.Enabled = True
End Sub

Private Sub Form_Activate()
bersih
txtnip.SetFocus
cmdsimpan.Enabled = False
End Sub

Private Sub txtcarinama_Change()
Data1.Recordset.Index = "idx_nama"
Data1.Recordset.Seek "<=", Trim(txtcarinama.Text) & "zzz"
End Sub

Private Sub txtcarikode_Change()
Data1.Recordset.Index = "idx_nip"
Data1.Recordset.Seek "<=", Trim(txtcarikode.Text) & "zzz"
End Sub

Private Sub txtTTL_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtjab.SetFocus
End If
End Sub

'code formguru

Private Sub cmbAgama_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtTelepon.SetFocus
End If
End Sub

Private Sub cmbKelas_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
mskTgl.SetFocus
End If
End Sub

Private Sub Command1_Click()
On Error Resume Next
CrystalReport1.WindowState = crptMaximized
CrystalReport1.RetrieveDataFiles
CrystalReport1.Action = 1
End Sub

Private Sub Form_Load()
Dim tang As String
Data1.DatabaseName = App.Path & "\spp.mdb"
Data1.RecordSource = "siswa"
mskTgl.Text = Format(Date, "dd/mm/yyyy")
CrystalReport1.ReportFileName = App.Path & "\lapsis.rpt"
End Sub

Private Function bersih()
txtnis.Text = ""
txtNama.Text = ""
txtAlamat.Text = ""
txtTgllahir.Text = ""
cmbAgama.Text = ""
txtTelepon.Text = ""
cmbKelas.Text = ""
mskTgl.Mask = ""
txtspp.Text = ""
opt1.Value = False
opt2.Value = False
cmdsimpan.Enabled = False
End Function

Private Sub DBGrid1_DblClick()
txtnis.Text = DBGrid1.Text
End Sub

Private Function tampil()
On Error Resume Next
txtnis.Enabled = False
txtNama.Text = Data1.Recordset!Nama
txtAlamat.Text = Data1.Recordset!alamat
txtTelepon.Text = Data1.Recordset!telepon
txtTgllahir.Text = Data1.Recordset!ttl
cmbAgama.Text = Data1.Recordset!agama
mskTgl.Text = Data1.Recordset!thnmsk
If Data1.Recordset!jk = "L" Then
opt1.Value = True
Else
opt2.Value = True
End If
txtspp.Text = Format(Data1.Recordset!spp, "#,#,0")
cmbKelas.Text = Data1.Recordset!kelas
cmdsimpan.Enabled = False
End Function

Private Sub cmdbatal_Click()
txtspp.Text = ""
bersih
cmdupdate.Enabled = False
txtnis.Enabled = True
txtnis.Text = ""
txtnis.SetFocus
End Sub

Private Sub cmdclose_Click()
formSiswa.Hide
' frmMenu.Show
End Sub

Private Sub cmdhapus_Click()
On Error Resume Next
s = MsgBox("Data akan dihapus ?", vbOKCancel, "PERHATIAN")
If s = vbOK Then
Data1.Recordset.Delete
End If
End Sub

Private Sub cmdsimpan_Click()
On Error Resume Next
If txtnis.Text = "" Then
MsgBox "NIS belum diisi", vbOKOnly, "Message Siswa"
Exit Sub
End If
If txtNama.Text = "" Or txtAlamat.Text = "" Or txtTgllahir.Text = "" _
Or cmbAgama.Text = "" Or cmbKelas.Text = "" _
Or (opt1.Value = False And opt2.Value = False) Or mskTgl.Text = "" Then
MsgBox "Ada yang belum diisi", vbOKOnly, "Message Siswa"
Exit Sub
End If
Data1.Recordset.AddNew
Data1.Recordset!nis = txtnis.Text
Data1.Recordset!Nama = txtNama.Text
Data1.Recordset!alamat = txtAlamat.Text
Data1.Recordset!telepon = txtTelepon.Text
Data1.Recordset!ttl = txtTgllahir.Text
Data1.Recordset!agama = cmbAgama.Text
Data1.Recordset!kelas = cmbKelas.Text
Data1.Recordset!thnmsk = mskTgl.Text
If opt1.Value = True Then
Data1.Recordset!jk = "L"
Else
Data1.Recordset!jk = "P"
End If
Data1.Recordset!spp = txtspp.Text
Data1.Recordset.Update
bersih
cmdsimpan.Enabled = False
End Sub

Private Sub cmdupdate_Click()
Data1.Recordset.Edit
Data1.Recordset!nis = txtnis.Text
Data1.Recordset!Nama = txtNama.Text
Data1.Recordset!alamat = txtAlamat.Text
Data1.Recordset!telepon = txtTelepon.Text
Data1.Recordset!ttl = txtTgllahir.Text
Data1.Recordset!agama = cmbAgama.Text
Data1.Recordset!kelas = cmbKelas.Text
Data1.Recordset!thnmsk = mskTgl.Text
If opt1.Value = True Then
Data1.Recordset!jk = "L"
Else
Data1.Recordset!jk = "P"
End If
Data1.Recordset!spp = txtspp.Text
Data1.Recordset.Update
bersih
cmdupdate.Enabled = False
txtnis.Enabled = True
cmdsimpan.Enabled = True
End Sub

Private Sub Form_Activate()
bersih
txtnis.SetFocus
End Sub

Private Sub text1_Change()

End Sub

Private Sub mskTgl_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtspp.SetFocus
End If
End Sub

Private Sub opt1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtTgllahir.SetFocus
End If
End Sub

Private Sub opt2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtTgllahir.SetFocus
End If
End Sub

Private Sub SSTab1_DblClick()
Data1.Refresh
DBGrid1.Refresh
End Sub

Private Sub txtalamat_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
opt1.SetFocus
End If
End Sub

Private Sub txtcarinama_Change()
Data1.Recordset.Index = "namapel"
Data1.Recordset.Seek "<=", Trim(Txtcarinama.Text) & "zzz"
If Data1.Recordset.NoMatch Then
MsgBox "Data tidak ada", vbOKOnly, "Message Siswa"
Exit Sub
End If
cmdhapus.Enabled = True
End Sub

Private Sub Txtcarinis_Change()
cmdhapus.Enabled = False
If Len(Txtcarinis.Text) < 5 Then
Exit Sub
End If
Data1.Recordset.Index = "nispel"
Data1.Recordset.Seek "=", Txtcarinis.Text
If Data1.Recordset.NoMatch Then
MsgBox "Data tidak ada", vbOKOnly, "Message Siswa"
Exit Sub
End If
cmdhapus.Enabled = True
End Sub

Private Sub txtkelas_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc("1") And KeyAscii <= Asc("3") Or KeyAscii = vbKeyBack) Then
Beep
KeyAscii = 0
End If
End Sub

Private Sub txtcariNis_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub

Private Sub txtnama_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
txtAlamat.SetFocus
End If
End Sub

Private Sub txtnis_Change()
Dim X As Byte
If Len(txtnis.Text) < 10 Then
Exit Sub
End If
cmdsimpan.Enabled = True
txtNama.SetFocus
Data1.Recordset.Index = "nispel"
Data1.Recordset.Seek "=", txtnis.Text
If Not Data1.Recordset.NoMatch Then
cmdupdate.Enabled = True
tampil
End If
End Sub

Private Sub Txtnis_LostFocus()
cmdbatal.Enabled = True
End Sub

Private Sub txtspp_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack) Then
Beep
KeyAscii = 0
End If
End Sub

Private Sub txtnis_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub

Private Sub txtTelepon_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
cmbKelas.SetFocus
End If
End Sub

Private Sub txtTgllahir_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
cmbAgama.SetFocus
End If
End Sub

'code form cetak
Dim p As Printer

Private Sub cmdList_Click()

End Sub

Private Sub preview()
Dim mno, mhal, mbaris, X As Integer
Dim mnilai, msubtotal, mtotal As Single
Dim mgrs As String
On Error GoTo 0
With dbtran.Recordset
'pb.Min = 1
'pb.Max = .RecordCount
.MoveFirst
Printer.CurrentX = 5
Printer.CurrentY = 5
mhal = 0
mno = 0
mtotal = 0
Do
mhal = mhal + 1
Form2.FontSize = Val(cbs.Text) * 2
Form2.FontBold = True
Form2.Print "Data Pembayaran SPP"
Form2.Print "SD Negeri 01 Blimbing - Malang"
Form2.FontSize = cbs.Text
Form2.FontBold = False
Form2.Print
Form2.Print Tab(10); "Kelas : "; !kelas;
Form2.Print Tab(100); "Hal :"; Format(mhal, "###")
Form2.Print
mgrs = String$(200, "-")
Form2.Print mgrs
Form2.Print Tab(2); "No. Tran";
Form2.Print Tab(10); "Tgl. Pem";
Form2.Print Tab(20); "NIS";
Form2.Print Tab(45); "Kelas";
Form2.Print Tab(60); "NIP";
Form2.Print Tab(70); "Bayar";
Form2.Print
Form2.Print mgrs
Form2.Print
mbaris = 0
msubtotal = 0
Do
mno = mno + 1
pb.Value = mno
Form2.Print Tab(1); rkanan(mno, "#####");
Form2.Print Tab(10); !nis;
Form2.Print Tab(20); !kelas;
Form2.Print Tab(45); rkanan(!bayar, "###,###,###");
Form2.Print Tab(60); !terlambat;
Form2.Print Tab(70); !sanksi;

mbaris = mbaris + 1
.MoveNext
If .EOF Then
Exit Do
End If
Loop Until mbaris > 55
Form2.Print
Form2.Print mgrs
' Form2.NewPage
If .EOF Then
Exit Do
End If
Loop
'Form2.EndDoc
pb.Value = .RecordCount
End With
On Error GoTo 0
Exit Sub
salahcetak:
Beep
d = MsgBox("Printer Error !" & Chr(13) & "Betulkan Printer lalu klik ok", vbOKCancel)
If d = 0 Then
Resume
Else
'Printer.KillDoc

End If
End Sub

Private Sub cmdprev_Click()
With CrystalReport1
.ReportFileName = App.Path & "\laptran.rpt"
.SelectionFormula = "month({transaksi.tgl_pem})=" & Combo1.ListIndex + 1 & " "
.RetrieveDataFiles
.WindowShowCloseBtn = True
.WindowState = crptMaximized
.Action = 1
End With
End Sub

Private Sub Command1_Click()
Unload Me
End Sub

Private Sub Command2_Click()
CrystalReport2.ReportFileName = App.Path & "\laptran.rpt"
CrystalReport2.WindowState = crptMaximized
CrystalReport2.RetrieveDataFiles
CrystalReport2.Action = 1
End Sub

Private Sub Form_Activate()
frmPrint.Visible = True
End Sub

Private Sub Form_Load()
dbtran.DatabaseName = App.Path & "\spp.mdb"
dbtran.RecordSource = "Select * From transaksi"
For bln = 1 To 12
bulan = Choose(bln, "januari", "februari", "maret", "april", "mei", "juni", "juli", "agustus", "september", "oktober", "november", "desember") & " " & Str(Year(Date))
Combo1.AddItem bulan
Next
End Sub



Private Sub cmdRefresh_Click()
dbtran.DatabaseName = App.Path & "\spp.mdb"
dbtran.RecordSource = "Select * From transaksi"
dbtran.Refresh
End Sub

Private Sub cbf_Click()
cbf.FontName = cbf.Text
End Sub

Private Sub cbp_Click()
For Each p In Printers
If p.DeviceName = cbp.Text Then
Set Printer = p
Exit For
End If
Next
End Sub


Private Sub cbs_Click()
cbs.FontSize = cbs.Text
End Sub

Private Sub cmdcetak_Click()
Dim mno, mhal, mbaris, X As Integer
Dim mnilai, msubtotal, mtotal As Single
Dim mgrs As String
On Error GoTo 0
With dbtran.Recordset
'pb.Min = 1
'pb.Max = .RecordCount
.MoveFirst
Printer.CurrentX = 5
Printer.CurrentY = 5
mhal = 0
mno = 0
mtotal = 0
Do
mhal = mhal + 1
Printer.FontSize = Val(cbs.Text) * 2
Printer.FontBold = True
Printer.Print "Data Pembayaran SPP"
Printer.Print "SD Negeri 01 Blimbing - Malang"
Printer.FontSize = cbs.Text
Printer.FontBold = False
Printer.Print
Printer.Print Tab(10); "Kelas : "; !kelas;
Printer.Print Tab(100); "Hal :"; Format(mhal, "###")
Printer.Print
mgrs = String$(200, "-")
Printer.Print mgrs
Printer.Print Tab(2); "No. Tran";
Printer.Print Tab(10); "Tgl. Pem";
Printer.Print Tab(20); "NIS";
Printer.Print Tab(45); "Kelas";
Printer.Print Tab(60); "NIP";
Printer.Print Tab(70); "Bayar";

Printer.Print
Printer.Print mgrs
Printer.Print
mbaris = 0
msubtotal = 0
Do
mno = mno + 1
pb.Value = mno
Printer.Print Tab(1); rkanan(mno, "#####");
Printer.Print Tab(10); !nis;
Printer.Print Tab(20); !kelas;
Printer.Print Tab(45); rkanan(!bayar, "###,###,###");
Printer.Print Tab(60); !terlambat;
Printer.Print Tab(70); !sanksi;

mbaris = mbaris + 1
.MoveNext
If .EOF Then
Exit Do
End If
Loop Until mbaris > 55
Printer.Print
Printer.Print mgrs
Printer.NewPage
If .EOF Then
Exit Do
End If
Loop
Printer.EndDoc
pb.Value = .RecordCount
End With
On Error GoTo 0

Exit Sub
salahcetak:
Beep
d = MsgBox("Printer Error !" & Chr(13) & "Betulkan Printer lalu klik ok", vbOKCancel)
If d = 0 Then
Resume
Else
Printer.KillDoc

End If
End Sub

Private Sub opmiring_Click()
Printer.Orientation = vbPRORLandscape
End Sub


Private Sub opportait_Click()
Printer.Orientation = vbPRORPortrait
End Sub

Private Sub txtcopy_LostFocus()
If Val(txtcopy.Text) <> 10 Then
Beep
txtcopy.SetFocus
End If
End Sub


Private Function rkanan(ndata, cformat) As String
rkanan = Format(ndata, cformat)
rkanan = Space(Len(cformat) - Len(rkanan)) + rkanan
End Function


Private Sub UpDown1_Change()
txtcopy.Text = UpDown1.Value
End Sub


'code formspp

Dim DB As Database
Dim RSsiswa As Recordset
Dim RStran As Recordset

Private Function clear()
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Text10.Text = ""
Text12.Text = ""
DBCombo1.Text = ""
DBCombo2.Text = ""
Combo1.Text = ""
Cmdsimpan.Enabled = False
cmdupdate.Enabled = False
End Function


Private Sub cmdupdate_Click()
Data1.Recordset.Edit
Data1.Recordset!Notran = Text1.Text
Data1.Recordset!tgl_pem = Text2.Text
Data1.Recordset!nis = DBCombo1.Text
Data1.Recordset!kelas = Text4.Text
Data1.Recordset!nip = DBCombo2.Text
Data1.Recordset!bayar = Text7.Text
Data1.Recordset!ket = Text8.Text
Data1.Recordset!terlambat = Text10.Text
Data1.Recordset!sanksi = Combo1.Text
Data1.Recordset!ket_sanksi = Text12.Text
Data1.Recordset.Update
clear
Text1.Enabled = True
Text1.Text = ""
Text1.SetFocus
End Sub

Private Sub Command1_Click()
On Error Resume Next
s = MsgBox("Data akan dihapus ?", vbOKCancel, "PERHATIAN")
If s = vbOK Then
Data1.Recordset.Delete
End If
End Sub

Private Sub DBCombo1_Change()
Data2.Recordset.Index = "nispel"
Data2.Recordset.Seek "=", DBCombo1.Text
If Not Data2.Recordset.NoMatch Then
Text3.Text = Data2.Recordset!Nama
Text4.Text = Data2.Recordset!kelas
Text5.Text = Format(Data2.Recordset!spp, "#,#,0")
Text9.Text = Format$(Data2.Recordset!thnmsk, "dddd, dd MMMM yyyy")
'Text10.Text = Val(Data2.Recordset!thnmsk) - (Format$(Date, "dd mm"))
End If
End Sub


Private Sub DBCombo2_Change()
Data3.Recordset.Index = "idx_nip"
Data3.Recordset.Seek "=", DBCombo2.Text
If Not Data3.Recordset.NoMatch Then
Text6.Text = Data3.Recordset!Nama
End If
End Sub

Private Sub Form_Activate()
Text1.Text = ""
Text1.SetFocus
clear
End Sub

Private Sub Form_Load()
Data1.DatabaseName = App.Path & "\spp.mdb"
Data1.RecordSource = "transaksi"
Data2.DatabaseName = App.Path & "\spp.mdb"
Data2.RecordSource = "siswa"
Data3.DatabaseName = App.Path & "\spp.mdb"
Data3.RecordSource = "guru"
Text2.Text = Date
Combo1.List(0) = "Peringatan"
Combo1.List(1) = "Denda"
Combo1.List(2) = "Skors"
Combo1.List(3) = "Dikeluarkan"
End Sub

Private Sub cmdbatal_Click()
clear
Text1.Enabled = True
Text1.Text = ""
Text1.SetFocus

End Sub

'Private Sub mnentry_Click()
' Dim I As Byte
' For I = 0 To 3
' txtno.Text = ""
'Next I
'txtno.SetFocus
'End Sub

Private Sub cmdkeluar_Click()
Unload Me
End Sub

Private Sub mnreport_Click()
'frmlapspp.Show
'frmspp.Hide
End Sub

Private Sub cmdsimpan_Click()
Dim tgl As Date
If Text1.Text = "" Or Text2.Text = "" Or DBCombo1.Text = "" Or DBCombo2.Text = "" Or Text7.Text = "" Or Text8.Text = "" Then
MsgBox "Ada yang belum terisi !!", vbOKOnly, "Pesan Transaksi"
Else
Data1.Recordset.AddNew
Data1.Recordset!Notran = Text1.Text
Data1.Recordset!tgl_pem = Text2.Text
Data1.Recordset!nis = DBCombo1.Text
Data1.Recordset!kelas = Text4.Text
Data1.Recordset!nip = DBCombo2.Text
Data1.Recordset!bayar = Text7.Text
Data1.Recordset!ket = Text8.Text
Data1.Recordset!terlambat = Text10.Text
Data1.Recordset!sanksi = Combo1.Text
Data1.Recordset!ket_sanksi = Text12.Text
Data1.Recordset.Update
clear
Text1.Text = ""
Text1.SetFocus
End If
End Sub

Private Sub text1_Change()
If Len(Text1.Text) < 6 Then
Exit Sub
End If
Cmdsimpan.Enabled = True
DBCombo1.SetFocus
Data1.Recordset.Index = "notran"
Data1.Recordset.Seek "=", Text1.Text
If Not Data1.Recordset.NoMatch Then
tampil
Text7.Text = Format(Data1.Recordset!bayar, "#,#,0")
Text8.Text = Data1.Recordset!ket
Text10.Text = Data1.Recordset!terlambat
Combo1.Text = Data1.Recordset!sanksi
Text12.Text = Data1.Recordset!ket_sanksi
cmdupdate.Enabled = True
Cmdsimpan.Enabled = False
End If

End Sub


Private Function tampil()
On Error Resume Next
Text1.Enabled = False
DBCombo1.Text = Data1.Recordset!nis
DBCombo2.Text = Data1.Recordset!nip
Text7.Text = Data1.Recordset!bayar
Text8.Text = Data1.Recordset!ket
Text9.Text = Data1.Recordset!batas
Text10.Text = Data1.Recordset!terlambat
Text12.Text = Data1.Recordset!ket_sanksi
End Function

Private Sub Text1_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub

Private Sub Text11_Change()
Cmdhapus.Enabled = False
If Len(Text11.Text) < 6 Then
Exit Sub
End If
Data1.Recordset.Index = "notran"
Data1.Recordset.Seek "=", Text11.Text
If Data1.Recordset.NoMatch Then
MsgBox "Data tidak ada", vbOKOnly, "PERHATIAN"
Exit Sub
End If
Cmdhapus.Enabled = True
End Sub

Private Sub Text11_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub

Private Sub Text2_Change()
Text2.Text = Date
End Sub

Private Sub Text7_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Text8.SetFocus
End If
End Sub

Private Sub Text8_Change()
If KeyAscii = 13 Then
Text10.SetFocus
End If
End Sub

Nah untuk source codenya silakan disedot disini