Random post

Home Program Visual Basic Penerimaan Siswa Baru Sekolah Mengemudi √ Isyarat Listing Form Jadwal Jadwal Penerimaan Siswa Baru

Monday, October 29, 2018

√ Isyarat Listing Form Jadwal Jadwal Penerimaan Siswa Baru

Diterbitkan

Setelah kita melihat contoh aplikasi kegiatan penerimaan siswa gres sekolah mengemudi memakai visual basic 6.0, selanjutnya kita akan menciptakan form jadwal.
Pertama-tama buat terlebih dahulu formnya ibarat dibawah ini, juga beri name masing-masing :

Catatan :
A. Tambahkan crystalreport beri name "cr"
B. tambahkan tabel grid, beri name "grid"
C. Buat 3 textbox gres dengan nama "thari", "harikelas", "tgl"
D.ttanggal memakai DTPicker
E. Tambahkan timer
F. Buat combobox gres beri nama "tnosiswa" letakan dibalik textbox "tnosiswa2"
G. Buat combobox gres beri nama "tkodebiaya" letakan dibalik textbox "tkodebiaya2"
H. Buat combobox gres beri nama ""tkodemobil" letakan dibalik textbox "tkodemobil2"
I. Buat combobox gres beri nama ""tkodejam" letakan dibalik textbox "tkodejam2"
J. Buat combobox gres beri nama "tpertemuan" letakan dibalik textbox "tpertemuan2"

1. ketikkan koding dibawah, letakkan paling atas
Dim a, b, d, c As String


2. Klik pada cbtambah dan pastekan koding berikut (ubah deklarasi ke click ):
Call koneksi
rsjadwal.Open "select*from tjadwal order by kodejadwal desc", KON
With rsjadwal
If .BOF And .EOF Then
tkodejadwal.Text = "KJ" + "0001"
Else
tkodejadwal.Text = "KJ" + Right(Str(Val(Right(.Fields("kodejadwal"), 4)) + 10001), 4)
End If
End With

 Call tampil
tnosiswa.Enabled = True
tnosiswa.SetFocus
tnosiswa.Clear
rspendaftaran.Open "select*from tpendaftaran", KON
rspendaftaran.MoveFirst
Do Until rspendaftaran.EOF
tnosiswa.AddItem (rspendaftaran.Fields("nis"))
rspendaftaran.MoveNext
Loop
cbtambah.Enabled = False
cbbatal.Enabled = True


3. Klik pada cbsimpan dan pastekan koding berikut (ubah deklarasi ke click ):
Call koneksi
rsjadwal.Open "select*from tjadwal where tanggal='" & ttanggal & "' and kodejam='" & tkodejam.Text & "' and kodemobil='" & tkodemobil.Text & "'", KON

 If rsjadwal.EOF Then

 Call simpan

 Else
a = rsjadwal!tanggal
rsjam.Open "select*from tjam where kodejam='" & tkodejam & "'", KON
b = rsjam!jam
rsdatamobil.Open "select*from tmobil where kodemobil='" & tkodemobil & "'", KON
c = rsdatamobil!platnomor
MsgBox "Jadwal Dengan Tanggal " & a & " dan Kode Jam " & b & " dengan kendaraan beroda empat platnomor " & c & " Sudah Terisi", vbCritical, "SIMPAN"
ttanggal.Enabled = True
tkodejam.Enabled = True
tkodemobil.Enabled = True
tkodemobil.SetFocus
End If

4. Klik pada cbsunting dan pastekan koding berikut (ubah deklarasi ke click ):
Call koneksi
tkodemobil.Enabled = True
ttanggal.Enabled = True
tkodejam.Enabled = False
tjam.Enabled = False
tkodejam.Clear
rsjam.Open "select*from tjam", KON
rsjam.MoveFirst
Do Until rsjam.EOF
tkodejam.AddItem (rsjam.Fields("kodejam"))
rsjam.MoveNext
Loop
tkodemobil.Clear
rsdatamobil.Open "select*from tmobil", KON
rsdatamobil.MoveFirst
Do Until rsdatamobil.EOF
tkodemobil.AddItem (rsdatamobil.Fields("kodemobil"))
rsdatamobil.MoveNext
Loop
Call aktif
tkodejadwal.Enabled = False
tnotrans.Enabled = False
tkodebiaya.Enabled = False
cbtambah.Enabled = False
cbsimpan.Enabled = False
cbhapus.Enabled = False
cbsunting.Enabled = False
tjam.Enabled = False
tpertemuan.Enabled = False
tnamasiswa.Enabled = False
tjpertemuan.Enabled = False
tkelas.Enabled = False
tplatnomor.Enabled = False
tkodejam2.Visible = False
tjam.Text = ""
ttanggal.SetFocus

5. Klik pada cbperbarui dan pastekan koding berikut (ubah deklarasi ke click ):
If tjam.Text = "" Then
MsgBox "Isi dahulu jam !", vbCritical
tkodejam.Enabled = True
tkodejam.SetFocus
Else
Call perbarui_tgljam
End If

6. Klik pada cbhapus dan pastekan koding berikut (ubah deklarasi ke click ):
Call koneksi
a = MsgBox("Yakin Ingin Hapus Data ini?", vbQuestion + vbYesNo, "tanya")
If a = vbYes Then
rsjadwal.Open "delete from tjadwal where kodejadwal='" & tkodejadwal.Text & "'", KON
bersih
tcari.Text = ""
MsgBox "Data Berhasil di hapus", vbInformation, "Info"
Call tidakterlihat
End If
Call nonaktif
cbtambah.Enabled = True
Call tampil

7. Klik pada cbbatal dan pastekan koding berikut (ubah deklarasi ke click ):
Call bersih
Call nonaktif
cbtambah.Enabled = True
Call tidakterlihat

8. Klik pada cbcari dan pastekan koding berikut (ubah deklarasi ke click ):
Call terlihat
Call koneksi
rsjadwal.Open "select*from tjadwal where kodejadwal='" & tcari.Text & "'", KON

 If rsjadwal.EOF Then
MsgBox "Data Tidak Ditemukan", vbCritical
Call bersih
tcari.SetFocus
Else
With rsjadwal
tkodejadwal.Text = .Fields("kodejadwal")
tnotrans.Text = .Fields("notrans_daftar")
tkodebiaya2.Text = .Fields("kodebiaya")
tkodemobil2.Text = .Fields("kodemobil")
tpertemuan2.Text = .Fields("pertemuanke")
tkodejam2.Text = .Fields("kodejam")

 End With
rspendaftaran.Open "select*from tpendaftaran where notrans_daftar='" & tnotrans.Text & "'", KON

 tnosiswa2.Text = rspendaftaran.Fields("nis")
tkelas.Text = rspendaftaran.Fields("kelas")

 rsbiaya.Open "select*from tbiaya where kodebiaya='" & tkodebiaya2.Text & "'", KON
tjpertemuan.Text = rsbiaya.Fields("jpertemuan")

 rsdatasiswa.Open "select*from tsiswa where nis='" & tnosiswa2.Text & "'", KON
tnamasiswa.Text = rsdatasiswa.Fields("namasiswa")

 rsdatamobil.Open "select*from tmobil where kodemobil='" & tkodemobil2.Text & "'", KON
tplatnomor.Text = rsdatamobil.Fields("platnomor")

 rsjam.Open "select*from tjam where kodejam='" & tkodejam2.Text & "'", KON
tjam.Text = rsjam.Fields("jam")
Call nonaktif
tkodejadwal.Enabled = False
cbsunting.Enabled = True
cbhapus.Enabled = True
cbbatal.Enabled = True

 End If

9. Klik pada cetak dan pastekan koding berikut (ubah deklarasi ke click ) dan sesuaikan penempatan datacrystal reportnya:
If tcetak.Text = "No Siswa" Then
cr.SelectionFormula = "Totext({tsiswa.nis})= '" & tcetaknis.Text & "'"
cr.ReportFileName = "D:\Perkuliahan\Tugas Akhir\Tugas Akhir\program\Laporan\jadwalpersiswa.rpt"
cr.WindowState = crptMaximized
cr.RetrieveDataFiles
cr.Action = 1
ElseIf tcetak.Text = "Tanggal" Then
cr.SelectionFormula = "Totext({tjadwal.tanggal})= '" & tcetaknis.Text & "'"
cr.ReportFileName = "D:\Perkuliahan\Tugas Akhir\Tugas Akhir\program\Laporan\jadwal_pertanggal.rpt"
cr.WindowState = crptMaximized
cr.RetrieveDataFiles
cr.Action = 1
Else
cr.ReportFileName = "D:\Perkuliahan\Tugas Akhir\Tugas Akhir\program\Laporan\jadwal.rpt"
cr.WindowState = crptMaximized
cr.RetrieveDataFiles
cr.Action = 1
End If

10. Klik pada bmenu dan pastekan koding berikut (ubah deklarasi ke click ):
a = MsgBox("Yakin Untuk Menutup Form Ini Dan kembali ke Menu Utama ?", vbCritical + vbYesNo, "INFO")
If a = vbYes Then
fjadwal.Hide
Call aktifuser
End If

11. Klik pada tcetak dan pastekan koding berikut (ubah deklarasi ke click ):
tcetaknis.Enabled = True
Call koneksi
If tcetak.Text = "No Siswa" Then
Call koneksi
rsjadwal.Open "select*from tjadwal", KON

 tcetaknis.Clear
rspendaftaran.Open "select*from tpendaftaran", KON
rspendaftaran.MoveFirst
Do Until rspendaftaran.EOF
tcetaknis.AddItem (rspendaftaran.Fields("nis"))
rspendaftaran.MoveNext
Loop

 ElseIf tcetak.Text = "Tanggal" Then
Call koneksi
rsjadwal.Open "select distinct tanggal from tjadwal order by 1", KON
rsjadwal.Requery
tcetaknis.Clear

 Do Until rsjadwal.EOF
tcetaknis.AddItem Format(rsjadwal!tanggal, "yyyy-mm-dd")
rsjadwal.MoveNext
Loop
Else
tcetaknis.Enabled = False
cetak.Enabled = True
tcetaknis.Clear
End If


12. Klik pada tcetaknis dan pastekan koding berikut (ubah deklarasi ke click ):
cetak.Enabled = True

13. Klik pada tkodebiaya dan pastekan koding berikut (ubah deklarasi ke click ):
Call koneksi
rsbiaya.Open "select*from tbiaya where kodebiaya='" & tkodebiaya.Text & "'", KON
If rsbiaya.EOF Then
tjpertemuan.Text = ""
Else
tjpertemuan.Text = rsbiaya!jpertemuan
tkodemobil.Enabled = True
tkodemobil.Clear
tkodemobil.SetFocus
rsdatamobil.Open "select*from tmobil", KON
rsdatamobil.MoveFirst
Do Until rsdatamobil.EOF
tkodemobil.AddItem (rsdatamobil.Fields("kodemobil"))
rsdatamobil.MoveNext
Loop

 End If

14. Klik pada tkodejam dan pastekan koding berikut (ubah deklarasi ke click ):
tkodejam2.Text = tkodejam
Call koneksi
Dim totalhari As Integer
Dim hari As Integer

 totalhari = DateDiff("d", ttanggal.Value, Date)
hari = totalhari - (umur * 365)
thari.Text = hari
If thari.Text >= 0 Then

 MsgBox "Hari ini atau hari kemarin tidak sanggup diinput", vbCritical
tkodejam.Enabled = False

 ttanggal.SetFocus
Else
rsjam.Open "select*from tjam where kodejam='" & tkodejam.Text & "'", KON

 tjam.Text = rsjam!jam
tjam.Enabled = False
Call simpan_perbarui
ttanggal.Enabled = False

 End If

15. Klik pada tkodemobil dan pastekan koding berikut (ubah deklarasi ke click ):
tkodemobil2.Text = tkodemobil
Call koneksi
rsdatamobil.Open "select*from tmobil where kodemobil='" & tkodemobil.Text & "'", KON
If rsdatamobil.EOF Then
tmerkmobil.Text = ""
Else
tplatnomor.Text = rsdatamobil!platnomor
tpertemuan.Enabled = True
tpertemuan.Clear
tpertemuan.SetFocus
For i = 1 To tjpertemuan.Text
tpertemuan.AddItem i
Next i

 End If

16. Klik pada tnosiswa dan pastekan koding berikut (ubah deklarasi ke click ):
Call koneksi

 rsdatasiswa.Open "select*from tsiswa where nis='" & tnosiswa.Text & "'", KON
tnamasiswa.Text = rsdatasiswa.Fields("namasiswa")
rspendaftaran.Open "select*from tpendaftaran where nis='" & tnosiswa.Text & "'", KON
tkelas.Text = rspendaftaran.Fields("kelas")
tnotrans.Text = rspendaftaran.Fields("notrans_daftar")
cbbatal.Enabled = True
tkodebiaya.Enabled = True
tkodebiaya.Clear
rsbiaya.Open "select*from tbiaya", KON

 tkodebiaya.AddItem (rspendaftaran.Fields("kodebiaya"))
cbtambah.Enabled = True


17. Klik pada tpertemuan dan pastekan koding berikut (ubah deklarasi ke click ):
Call koneksi
rsjadwal.Open "select*from tjadwal where pertemuanke='" & tpertemuan.Text & "' and notrans_daftar='" & tnotrans.Text & "'", KON

 If rsjadwal.EOF Then
ttanggal.Enabled = True
tkodejam.Enabled = True
tkodejam.Clear

 rsjam.Open "select*from tjam", KON
rsjam.MoveFirst
Do Until rsjam.EOF
tkodejam.AddItem (rsjam.Fields("kodejam"))
rsjam.MoveNext
Loop

 Else
a = rsjadwal!notrans_daftar
b = rsjadwal!pertemuanke
MsgBox "Pertemuan Ke " & b & " dengan Nomor transaksi " & a & " Sudah Terisi", vbCritical, "SIMPAN"
tpertemuan.SetFocus
End If



18. Klik pada ttanggal dan pastekan koding berikut (ubah deklarasi ke change ):
Call kelas

19. Buat SUB aktif dan pastekan koding berikut :
cbtambah.Enabled = True
cbsimpan.Enabled = True
cbsunting.Enabled = True
cbperbarui.Enabled = True
cbhapus.Enabled = True
cbbatal.Enabled = True
tkodejadwal.Enabled = True
tnotrans.Enabled = True
tnosiswa.Enabled = True
tnamasiswa.Enabled = True
tkodebiaya.Enabled = True
tjpertemuan.Enabled = True
tkelas.Enabled = True
tkodemobil.Enabled = True
tplatnomor.Enabled = True
tpertemuan.Enabled = True
ttanggal.Enabled = True
tjam.Enabled = True
tkodejam.Enabled = True

20. Buat SUB nonaktif dan pastekan koding berikut :
cbtambah.Enabled = False
cbsimpan.Enabled = False
cbsunting.Enabled = False
cbperbarui.Enabled = False
cbhapus.Enabled = False
cbbatal.Enabled = False
tkodejadwal.Enabled = False
tnotrans.Enabled = False
tnosiswa.Enabled = False
tnamasiswa.Enabled = False
tkodebiaya.Enabled = False
tjpertemuan.Enabled = False
tkelas.Enabled = False
tkodemobil.Enabled = False
tplatnomor.Enabled = False
tpertemuan.Enabled = False
ttanggal.Enabled = False
tjam.Enabled = False
tkodejam.Enabled = False

21. Buat SUB higienis dan pastekan koding berikut :
tkodejadwal.Text = ""
tnotrans.Text = ""

 tnamasiswa.Text = ""

 tjpertemuan.Text = ""
tkelas.Text = ""

 tplatnomor.Text = ""
tjam.Text = ""

 tcari.Text = ""

22. Buat SUB tampil dan pastekan koding berikut :
Call koneksi
rsjadwal.Open "select*from tjadwal", KON
Set grid.DataSource = rsjadwal

23. Buat SUB terlihat dan pastekan koding berikut :
tnosiswa2.Visible = True
tkodebiaya2.Visible = True
tpertemuan2.Visible = True
tkodemobil2.Visible = True
tkodejam2.Visible = True
tnosiswa2.Enabled = False
tkodebiaya2.Enabled = False
tpertemuan2.Enabled = False
tkodemobil2.Enabled = False
tkodejam2.Enabled = False

24. Buat SUB tidakterlihat dan pastekan koding berikut :
tnosiswa2.Visible = False
tkodebiaya2.Visible = False
tpertemuan2.Visible = False
tkodemobil2.Visible = False

25. Buat SUB perbarui_tgljam dan pastekan koding berikut :
Call koneksi
rsjadwal.Open "select*from tjadwal where tanggal='" & ttanggal & "' and kodejam='" & tkodejam2.Text & "' and kodemobil='" & tkodemobil2.Text & "'", KON

 If rsjadwal.EOF Then

 Call perbarui
Call tidakterlihat
Else
a = rsjadwal!tanggal
rsjam.Open "select*from tjam where kodejam='" & tkodejam & "'", KON
b = rsjam!jam
rsdatamobil.Open "select*from tmobil where kodemobil='" & tkodemobil2 & "'", KON
c = rsdatamobil!platnomor
MsgBox "Jadwal Dengan Tanggal " & a & " dan Kode Jam " & b & " dengan kendaraan beroda empat platnomor " & c & " Sudah Terisi", vbCritical, "SIMPAN"
ttanggal.Enabled = True
tkodejam.Enabled = True
tkodemobil.Enabled = True
tkodemobil.SetFocus
End If

26. Buat SUB perbarui dan pastekan koding berikut :
Call koneksi
rsjadwal.Open "update tjadwal set kodemobil='" & tkodemobil2.Text & "',tanggal='" & ttanggal & "',kodejam='" & tkodejam2 & "' where kodejadwal='" & tkodejadwal.Text & "'", KON

 MsgBox "Data Berhasil di Update", vbInformation, "Info"
bersih
Call tampil
Call nonaktif
cbtambah.Enabled = True

27. Buat SUB simpan dan pastekan koding berikut :
Call koneksi

 rsjadwal.Open "insert into tjadwal set kodejadwal='" & tkodejadwal & "',notrans_daftar='" & tnotrans & "',kodebiaya='" & tkodebiaya & "',kodemobil='" & tkodemobil2 & "',pertemuanke='" & tpertemuan & "',tanggal='" & ttanggal & "',kodejam='" & tkodejam2 & "'", KON
MsgBox "Data Sudah Tersimpan", vbInformation
Call tampil
Call bersih
Call nonaktif
cbtambah.Enabled = True

28. Buat SUB aktifuser dan pastekan koding berikut :
fmenu.mlog.Enabled = True
fmenu.mganti.Enabled = True
fmenu.mdata.Enabled = True
fmenu.mdatabiaya.Enabled = False
fmenu.mdatauser.Enabled = False
fmenu.mdatasiswa.Enabled = True
fmenu.mjadwal.Enabled = True
fmenu.mtransaksi.Enabled = True
fmenu.mlaporan.Enabled = True
fmenu.mlogout.Enabled = True
fmenu.mloguser.Enabled = False
fmenu.mmobil.Enabled = False
fmenu.mjam.Enabled = False

29. Buat form load dan pastekan koding berikut :
Me.Left = 100
Me.Top = 0
Call bersih
Call nonaktif
Call tampil
cbtambah.Enabled = True
Me.Width = 19695
Me.Height = 9885
tcetaknis.Enabled = False
cetak.Enabled = False
tcetaknis.Clear
ttanggal.Value = Format(Date, "yyyy-mm-dd")

30. klik timer dan pastekan koding berikut :
tgl.Text = Format(Date, "yyyy-mm-dd")

31. Buat SUB simpan_perbarui dan pastekan koding berikut :
If cbperbarui.Enabled = True Then
cbsimpan.Enabled = False
Else
cbsimpan.Enabled = True
End If

32. Buat SUB kelas dan pastekan koding berikut :
harikelas.Text = (Format(ttanggal.Value, "dddd"))

 If harikelas.Text = "Senin" And tkelas.Text = "Karyawan" Then
MsgBox "Kelas Karyawan hanya tersedia Sabtu & Minggu", vbCritical
ttanggal.Enabled = True
ttanggal.Value = Format(Date, "yyyy-mm-dd")
tjam.Text = ""
tkodejam.Enabled = False
ttanggal.SetFocus
ElseIf harikelas.Text = "Selasa" And tkelas.Text = "Karyawan" Then
MsgBox "Kelas Karyawan hanya tersedia Sabtu & Minggu", vbCritical
ttanggal.Enabled = True
ttanggal.Value = Format(Date, "yyyy-mm-dd")
tjam.Text = ""
tkodejam.Enabled = False
ttanggal.SetFocus
ElseIf harikelas.Text = "Rabu" And tkelas.Text = "Karyawan" Then
MsgBox "Kelas Karyawan hanya tersedia Sabtu & Minggu", vbCritical
ttanggal.Enabled = True
ttanggal.Value = Format(Date, "yyyy-mm-dd")
tjam.Text = ""
tkodejam.Enabled = False
ttanggal.SetFocus
ElseIf harikelas.Text = "Kamis" And tkelas.Text = "Karyawan" Then
MsgBox "Kelas Karyawan hanya tersedia Sabtu & Minggu", vbCritical
ttanggal.Enabled = True
ttanggal.Value = Format(Date, "yyyy-mm-dd")
tjam.Text = ""
tkodejam.Enabled = False
ttanggal.SetFocus
ElseIf harikelas.Text = "Jumat" And tkelas.Text = "Karyawan" Then
MsgBox "Kelas Karyawan hanya tersedia Sabtu & Minggu", vbCritical
ttanggal.Enabled = True
ttanggal.Value = Format(Date, "yyyy-mm-dd")
tjam.Text = ""
tkodejam.Enabled = False
ttanggal.SetFocus
ElseIf harikelas.Text = "Sabtu" And tkelas.Text = "Reguler" Then
MsgBox "Kelas Reguler hanya tersedia Senin s/d Jumat", vbCritical
ttanggal.Enabled = True
ttanggal.Value = Format(Date, "yyyy-mm-dd")
tjam.Text = ""
tkodejam.Enabled = False
ttanggal.SetFocus
ElseIf harikelas.Text = "Minggu" And tkelas.Text = "Reguler" Then
MsgBox "Kelas Reguler hanya tersedia Senin s/d Jumat", vbCritical
ttanggal.Enabled = True
ttanggal.Value = Format(Date, "yyyy-mm-dd")
tjam.Text = ""
tkodejam.Enabled = False
ttanggal.SetFocus
Else
tkodejam.Enabled = True
End If





Sumber http://www.hendrisetiawan.com

Artikel Terkait

hiyahiya

Next Post
Previous Post