Kali ini penulis mencoba membuat program pendaftaran siswa baru untuk sekolah karena ada salah satu vbthok mania yang mungkin ingin membuat program tersebut tapi masih bingung. Program ini berdasarkan pengamatan penulis jadi mungkin masih ada yang kurang, untuk itu vbthok mania bisa kembangkan sendiri sesuai ide dari vbthok mania.
1. form menu
2. form sekolah
3. form pendaftaran siswa baru
4. form siswa baru
5. form laporan data calon siswa baru
6. form laporan data siswa baru yang diterima
7. form laporan daftar siswa baru
berikut tampilan untuk programnya..
Dan berikut untuk script kodenya
'untuk form menu
Private Sub Mnbaru_Click()
Siswa.Show
End Sub
Private Sub mncadangan_Click()
lcadangan.Show
End Sub
Private Sub mncalon_Click()
Calon.Show
End Sub
Private Sub mncbaru_Click()
lcalon.Show
End Sub
Private Sub mnkel_Click()
Unload Me
End Sub
Private Sub mnsek_Click()
Sekolah.Show
End Sub
Private Sub mnsiswa_Click()
datas.Show
End Sub
Private Sub mnterima_Click()
lditerima.Show
End Sub
'untuk form sekolah
Public dbrayon As Database
Public rsrayon As Recordset
Private Sub hapus_Click()
rsrayon.Delete
Call bersih
End Sub
Private Sub keluar_Click()
Unload Me
End Sub
Private Sub koreksi_Click()
rsrayon.Edit
rsrayon(1) = rayo.Text
rsrayon(0) = nama.Text
rsrayon.Update
Call bersih
End Sub
Private Sub simpan_Click()
rsrayon.AddNew
rsrayon(1) = rayo.Text
rsrayon(0) = nama.Text
rsrayon.Update
Call bersih
End Sub
Private Sub bersih()
nama.Text = ""
rayo.Text = ""
nama.SetFocus
End Sub
Private Sub Form_Load()
Set dbrayon = OpenDatabase(App.Path & "\Siswa baru.mdb")
Set rsrayon = dbrayon.OpenRecordset("Rayon")
rsrayon.Index = "cari"
nama = ""
End Sub
Private Sub nama_Change()
rsrayon.Seek "=", nama.Text
If rsrayon.NoMatch Then
simpan.Enabled = True
Hapus.Enabled = False
Koreksi.Enabled = False
ElseIf Not rsrayon.NoMatch Then
rayo.Text = rsrayon(1)
simpan.Enabled = False
Hapus.Enabled = True
Koreksi.Enabled = True
End If
End Sub
'form daftar siswa baru
Public dbcalon As Database
Public rscalon As Recordset
Public dbsiswa As Database
Public rssiswa As Recordset
Private Sub daftar_Click()
rscalon.Seek "=", daftar.Text
If Not rscalon.NoMatch Then
nis.Text = ""
nama.Text = rscalon(1)
alamat.Text = rscalon(2)
Kelamin.Text = rscalon(3)
tempat.Text = rscalon(4)
tanggal.Value = rscalon(5)
daftar.Enabled = False
nama.Enabled = False
alamat.Enabled = False
Kelamin.Enabled = False
tempat.Enabled = False
tanggal.Enabled = False
Else
nis.Text = ""
nama.Text = ""
alamat.Text = ""
Kelamin.Text = ""
tempat.Text = ""
'tanggal.Value = ""
End If
End Sub
Private Sub koreksi_Click()
rssiswa.Edit
rssiswa(0) = nis.Text
rssiswa(1) = nama.Text
rssiswa(2) = alamat.Text
rssiswa(3) = Kelamin.Text
rssiswa(4) = tempat.Text
rssiswa(5) = tanggal.Value
rssiswa(6) = wali.Text
rssiswa.Update
Call bersih
End Sub
Private Sub hapus_Click()
rssiswa.Delete
Call bersih
End Sub
Private Sub keluar_Click()
Unload Me
End Sub
Private Sub nis_Change()
rssiswa.Seek "=", nis.Text
If rssiswa.NoMatch Then
wali = ""
simpan.Enabled = True
Hapus.Enabled = False
Koreksi.Enabled = False
ElseIf Not rssiswa.NoMatch Then
nama.Text = rssiswa(1)
alamat.Text = rssiswa(2)
Kelamin.Text = rssiswa(3)
tempat.Text = rssiswa(4)
tanggal.Value = rssiswa(5)
wali.Text = rssiswa(6)
nama.Enabled = True
Kelamin.Enabled = True
alamat.Enabled = True
tempat.Enabled = True
tanggal.Enabled = True
simpan.Enabled = False
Hapus.Enabled = True
Koreksi.Enabled = True
End If
End Sub
Private Sub simpan_Click()
rssiswa.AddNew
rssiswa(0) = nis.Text
rssiswa(1) = nama.Text
rssiswa(2) = alamat.Text
rssiswa(3) = Kelamin.Text
rssiswa(4) = tempat.Text
rssiswa(5) = tanggal.Value
rssiswa(6) = wali.Text
rssiswa.Update
Call bersih
End Sub
Private Sub bersih()
daftar.Text = ""
nis.Text = ""
nama.Text = ""
alamat.Text = ""
Kelamin.Text = ""
tempat.Text = ""
wali.Text = ""
daftar.Enabled = True
daftar.SetFocus
End Sub
Private Sub Form_Load()
Set dbcalon = OpenDatabase(App.Path & "\Siswa baru.mdb")
Set rscalon = dbcalon.OpenRecordset("calon")
rscalon.Index = "cari1"
Set dbsiswa = OpenDatabase(App.Path & "\Siswa baru.mdb")
Set rssiswa = dbsiswa.OpenRecordset("siswa")
rssiswa.Index = "cari"
rscalon.MoveFirst
While Not rscalon.EOF
daftar.AddItem (rscalon(0))
rscalon.MoveNext
Wend
End Sub
'form laporan calon siswa baru
Public dbcalon As Database
Public rscalon As Recordset
Public dblaporan As Database
Public rslaporan As Recordset
Private Sub HapusTabel()
If rslaporan.RecordCount <> 0 Then
Do While Not rslaporan.EOF
rslaporan.Delete
rslaporan.MoveNext
Loop
End If
End Sub
Private Sub cmdBatal_Click()
Unload Me
End Sub
Private Sub cmdProses_Click()
Set dblaporan = OpenDatabase(App.Path & "\laporan.mdb")
Set rslaporan = dblaporan.OpenRecordset("lap1")
HapusTabel
rscalon.MoveFirst
Do While Not rscalon.EOF
rslaporan.AddNew
rslaporan(0) = Tahun
rslaporan(1) = rscalon(0)
rslaporan(2) = rscalon(1)
rslaporan(3) = rscalon(5)
rslaporan(4) = rscalon(3)
rslaporan(5) = rscalon(6)
rslaporan(6) = rscalon(7)
rslaporan.Update
rscalon.MoveNext
Loop
dblaporan.Close
lap.ReportFileName = App.Path & "\lap1.rpt"
lap.DataFiles(0) = App.Path & "\laporan.mdb"
lap.WindowState = crptMaximized
lap.WindowTitle = "Laporan Daftar Calon Siswa"
lap.Action = 28
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
Set dbcalon = OpenDatabase(App.Path & "\siswa baru.mdb")
Set rscalon = dbcalon.OpenRecordset("calon")
rscalon.Index = "cari1"
End Sub
'form calon siswa baru yang diterima
Public dbcalon As Database
Public rscalon As Recordset
Public dblaporan As Database
Public rslaporan As Recordset
Public dbrayon As Database
Public rsrayon As Recordset
Private Sub HapusTabel()
If rslaporan.RecordCount <> 0 Then
Do While Not rslaporan.EOF
rslaporan.Delete
rslaporan.MoveNext
Loop
End If
End Sub
Private Sub cmdBatal_Click()
Unload Me
End Sub
Private Sub cmdProses_Click()
Set dblaporan = OpenDatabase(App.Path & "\laporan.mdb")
Set rslaporan = dblaporan.OpenRecordset("lap2")
HapusTabel
rscalon.MoveFirst
Do While Not rscalon.EOF
If (rscalon(8) = "C" And rscalon(7) >= 33) Or (rscalon(8) <> "C" And rscalon(7) >= 43) Then
rslaporan.AddNew
rslaporan(0) = Tahun
rslaporan(1) = rscalon(0)
rslaporan(2) = rscalon(1)
rslaporan(3) = rscalon(3)
rslaporan(4) = rscalon(7)
rslaporan.Update
End If
rscalon.MoveNext
Loop
dblaporan.Close
lap.ReportFileName = App.Path & "\lap2.rpt"
lap.DataFiles(0) = App.Path & "\laporan.mdb"
lap.WindowState = crptMaximized
lap.WindowTitle = "Laporan Daftar Calon Siswa Yang Diterima"
lap.Action = 28
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
Set dbcalon = OpenDatabase(App.Path & "\siswa baru.mdb")
Set rscalon = dbcalon.OpenRecordset("calon")
Set dbrayon = OpenDatabase(App.Path & "\siswa baru.mdb")
Set rsrayon = dbcalon.OpenRecordset("rayon")
rscalon.Index = "cari1"
End Sub
'form laporan siswa baru
Public dbsiswa As Database
Public rssiswa As Recordset
Public dblaporan As Database
Public rslaporan As Recordset
Private Sub HapusTabel()
If rslaporan.RecordCount <> 0 Then
Do While Not rslaporan.EOF
rslaporan.Delete
rslaporan.MoveNext
Loop
End If
End Sub
Private Sub cmdBatal_Click()
Unload Me
End Sub
Private Sub cmdProses_Click()
Set dblaporan = OpenDatabase(App.Path & "\laporan.mdb")
Set rslaporan = dblaporan.OpenRecordset("lap3")
HapusTabel
rssiswa.MoveFirst
Do While Not rssiswa.EOF
rslaporan.AddNew
rslaporan(0) = Tahun
rslaporan(1) = rssiswa(0)
rslaporan(2) = rssiswa(1)
rslaporan(3) = rssiswa(4)
rslaporan(4) = rssiswa(5)
rslaporan(5) = rssiswa(3)
rslaporan(6) = rssiswa(2)
rslaporan(7) = rssiswa(6)
rslaporan.Update
rssiswa.MoveNext
Loop
dblaporan.Close
lap.ReportFileName = App.Path & "\lap4.rpt"
lap.DataFiles(0) = App.Path & "\laporan.mdb"
lap.WindowState = crptMaximized
lap.WindowTitle = "Laporan Daftar siswa Siswa"
lap.Action = 28
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
Set dbsiswa = OpenDatabase(App.Path & "\siswa baru.mdb")
Set rssiswa = dbsiswa.OpenRecordset("siswa")
'rssiswa.Index = "cari1"
End Sub
Untuk format laporan penulis menggunakan cristal report jadi silakan vbthok mania menginstall dulu program cristal report.Mohon maaf jika disini saya tidak menyediakan program cristal reportnya karena takut dituntut karena menyebarkan tanpa persetujuan..hehehe...
Untuk desain silakan dikembangakan sendiri karena disini penulis hanya membantu semoga vbthok mania jadi lebih kreatif. berikut source code lengkapnya yang bisa anda download disini
Terimakasi.
Sumber : deriffshare
0 Komentar:
Posting Komentar