1 SISTEM INFORMASI ADMINISTRASI PELATIHAN PRIVAT KOMPUTER PADA DELLSA COMPUTER BANGGAI (Ms. Visual Basic 6.0) Sebelum anda memulai pembuatan program, terlebih dahulu anda harus mempersiapkan kebutuhan-kebutuhan yang akan dipergunakan.Diantaranya : 1. Komputer anda harus terinstal Visual Basic 6 secara lengkap, dilengkapi dengan komponen tambahan yaitu XPButton serta icon-icon pendukungnya. 2. Harus terinstal Crystal Report. Versi yang terbaik disarankan memakai versi 8.5 3. Untuk pembuatan database, kita harus menggunakan program aplikasi Ms. Acces agar memudahkan anda didalam pengaturan backup data. Catatan : Perlu anda ketahui bahwa program ini sesuai dengan sistem administrasi yang ada pada Dellsa Computer Banggai. Kekurangan dari Program ini adalah PR buat anda dan kelebihannya ada pada programmer itu sendiri, Ok. Selamat Bekerja !!!
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
2
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
3
Selanjutnya kita harus mempersiapkan komponen-komponen yang kita perlukan pada Visual Basic, cara : klik kanan pada Toolbox, maka akan tampil gambar dibawah ini : Ceklist komponen-komponen : 1. Crystal Report Control 2. Microsoft Ado Data Control 6.0 (OLEDB) 3. Microsoft DataGrid Control 6.0 (OLEDB) 4. Microsoft Windows Common Control 5.0(ELEDB) 5. Microsoft Windows Common Control 6.0 6. Microsoft Windows Common Control -2.6.0 7. UcXPButton
Buat modul baru dengan mengklik pada menu Project... Add Module, ketik listing dibawah ini dan simpan dengan nama Modul1 Public Koneksi As New ADODB.Connection Public RsLogin As New ADODB.Recordset Public Rssiswa As New ADODB.Recordset Public Rsbiaya As New ADODB.Recordset Public Rskelas As New ADODB.Recordset Public Rspaket As New ADODB.Recordset Public Rsalumni As New ADODB.Recordset Public Rspembayaran As New ADODB.Recordset Public Rstunggu As New ADODB.Recordset Public Rsstatus As New ADODB.Recordset Sub BukaDatabase() Set Koneksi = Nothing Koneksi.CursorLocation = adUseClient Koneksi.Open "Provider = Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\dbsprivat.mdb;jet OLEDB:Database Password=;" Rssiswa.Open "[tblsiswa]", Koneksi, adOpenDynamic, adLockOptimistic Rsbiaya.Open "[tblbiaya]", Koneksi, adOpenDynamic, adLockOptimistic Rskelas.Open "[tblkelas]", Koneksi, adOpenDynamic, adLockOptimistic Rspaket.Open "[tblpaket]", Koneksi, adOpenDynamic, adLockOptimistic Rsalumni.Open "[tblalumni]", Koneksi, adOpenDynamic, adLockOptimistic Rspembayaran.Open "[tblpembayaran]", Koneksi, adOpenDynamic, adLockOptimistic Rstunggu.Open "[tbltunggu]", Koneksi, adOpenDynamic, adLockOptimistic Rsstatus.Open "[tblstatus]", Koneksi, adOpenDynamic, adLockOptimistic RsLogin.Open "[Password]", Koneksi, adOpenDynamic, adLockOptimistic End Sub Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
4
Design Form seperti gambar dibawah ini, dan berikan nama FrmPaket Form Paket Pelatihan
Ketik Listing dibawah ini ! Public Ada1, Valid As Boolean Dim RsTampil As New ADODB.Recordset Private Sub blankform1() txtnamapkt.Text = "" cbolama.Text = "" End Sub Private Sub tidaksiapisi() txtnamapkt.Enabled = False cbolama.Enabled = False txtnamapkt.BackColor = &H80000016 cbolama.BackColor = &H80000016 End Sub Private Sub SiapIsi1() txtnamapkt.Enabled = True cbolama.Enabled = True txtnamapkt.BackColor = &H80000005 cbolama.BackColor = &H80000005 End Sub Private Sub isitabelpaket() Rspaket!kodepkt = txtkode.Text Rspaket!namapkt = txtnamapkt.Text Rspaket!Lamabljr = cbolama.Text End Sub Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
5
Private Sub AktifTombol() cmdsimpan.Enabled = True cmdedit.Enabled = True cmdhapus.Enabled = True End Sub Private Sub tutuptombol() cmdhapus.Enabled = False cmdedit.Enabled = False End Sub Private Sub isiformpaket() txtnamapkt.Text = Rspaket!namapkt cbolama.Text = Rspaket!Lamabljr End Sub Private Sub Validasi() Valid = False If txtkode.Text = Empty Then x = MsgBox("Kode Jurusan harus diisi", 0 + 16, "konfirmasi") txtkode.Text = "" txtkode.SetFocus Exit Sub ElseIf txtnamapkt.Text = Empty Then x = MsgBox("namapkt Jurusan harus diisi", 0 + 16, "konfirmasi") txtnamapkt.Text = "" txtnamapkt.SetFocus Exit Sub ElseIf cbolama.Text = Empty Then x = MsgBox("Lama Pelatihan harus diisi", 0 + 16, "konfirmasi") cbolama.Text = "" cbolama.SetFocus Exit Sub End If Valid = True End Sub Private Sub Tampildata() Set RsTampil = Nothing RsTampil.Open "select * from Tblpaket order by KodePkt ", Koneksi, adOpenDynamic, adLockOptimistic Set Grid1.DataSource = RsTampil Grid1.Columns(0).Width = 1500 Grid1.Columns(1).Width = 5700 Grid1.Columns(2).Width = 1250 Grid1.Columns(0).Alignment = dbgCenter Grid1.Columns(2).Alignment = dbgCenter Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
6
Grid1.Columns(0).Caption = "KODE PAKET" Grid1.Columns(1).Caption = "NAMA PAKET" Grid1.Columns(2).Caption = "LAMA PELATIHAN" End Sub Private Sub Form_Activate() mdmenuutama.Enabled = False End Sub Private Sub Form_Load() BukaDatabase blankform1 tidaksiapisi tutuptombol txtkode.Text = "" cmdsimpan.Caption = "&Tambah" Tampildata cbolama.List(0) = "1 Bulan " cbolama.List(1) = "2 Bulan " cbolama.List(2) = "3 Bulan " cbolama.List(3) = "4 Bulan " End Sub Private Sub Form_Unload(Cancel As Integer) Koneksi.Close End Sub Private Sub txtkode_Click() txtnamapkt.Text = "" cbolama.Text = "" End Sub Private Sub txtkode_KeyPress(keyascii As Integer) If Not (keyascii >= Asc("0") And keyascii <= Asc("9") Or _ keyascii = vbKeyBack) Then keyascii = 0 End If End Sub Private Sub txtkode_Lostfocus() ckode = Trim(txtkode.Text) If ckode = Empty Then Exit Sub End If Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
7
If Rspaket.RecordCount > 0 Then Rspaket.MoveFirst End If Rspaket.Find ("KodePkt = '" & ckode & "'") If Rspaket.EOF Then blankform1 SiapIsi1 txtnamapkt.SetFocus Ada1 = False tutuptombol cmdsimpan.Caption = "&Simpan" Else tidaksiapisi isiformpaket cmdedit.Enabled = True cmdhapus.Enabled = True Ada1 = True End If End Sub Private Sub CmdSimpan_Click() If cmdsimpan.Caption = "&Tambah" Then CmdBatal_Click Exit Sub End If Validasi If Valid = True Then If Ada1 = False Then Rspaket.AddNew isitabelpaket Rspaket.Update Else Koneksi.Execute "update Tblpaket set namapkt='" + txtnamapkt + "'," & "Lamabljr='" + cbolama + "' where KodePkt ='" + txtkode + "'" End If cmdsimpan.Caption = "&Tambah" Else cmdsimpan.Caption = "&Simpan" End If Rspaket.Requery Tampildata End Sub
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
8
Private Sub CmdBatal_Click() blankform1 tidaksiapisi txtkode.Enabled = True txtkode.BackColor = &H80000005 txtkode.SetFocus cmdsimpan.Caption = "&Tambah" tutuptombol End Sub Private Sub cmdedit_click() tutuptombol Ada1 = True SiapIsi1 txtkode.Enabled = False txtkode.BackColor = &H80000016 cmdsimpan.Caption = "&Simpan" txtnamapkt.SetFocus End Sub Private Sub CmdHapus_Click() ckode = Trim(txtkode.Text) Rssiswa.Find ("KodePkt='" & ckode & "'"), , adSearchForward, 1 Rspembayaran.Find ("KodePkt='" & ckode & "'"), , adSearchForward, 1 If Not Rssiswa.EOF Then x = MsgBox("maaf paket pelatihan tersebut tidak dapat dihapus", 0 + 16, "konfirmasi") txtkode.SetFocus Exit Sub ElseIf Not Rspembayaran.EOF Then x = MsgBox("maaf paket pelatihan tersebut tidak dapat dihapus", 0 + 16, "konfirmasi") txtkode.SetFocus Exit Sub Else Y = MsgBox("Benar anda ingin hapus ???", vbYesNo + vbQuestion + vbDefaultButton2, "konfirmasi") Select Case Y Case vbYes Koneksi.Execute "delete * from Tblpaket where KodePkt ='" & ckode & "'" Case vbNo End Select End If CmdBatal_Click Rspaket.Requery Tampildata End Sub Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
9
Private Sub CmdKeluar_Click() Unload Me mdmenuutama.Enabled = True End Sub Private Sub Grid1_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then If Rspaket.RecordCount > 0 Then txtkode.Text = Grid1.Columns(0) txtkode_Lostfocus End If End If End Sub Private Sub txtkode_keydown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub cbolama_keydown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txtnamapkt_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
10
Design Form seperti gambar dibawah ini, dan berikan nama FrmJenisBiaya Form Jenis Biaya Pelatihan
Ketik Listing dibawah ini ! Public Ada, Ada1, Valid As Boolean Public Sql As String Dim RsTampil As New ADODB.Recordset Private Sub blankform1() txtjnsby.Text = "" txtkodeby.Text = "" txtjnsby.Text = "" txtjml.Text = "" End Sub Private Sub Blankform2() txtkodeby.Text = "" txtjnsby.Text = "" txtjml.Text = "" End Sub Private Sub tidaksiapisi() txtjnsby.Enabled = False txtkodeby.Enabled = False txtjnsby.Enabled = False Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
11
txtjml.Enabled = False txtjnsby.BackColor = &H80000016 txtkodeby.BackColor = &H80000016 txtjnsby.BackColor = &H80000016 txtjml.BackColor = &H80000016 End Sub Private Sub SiapIsi1() txtjnsby.Enabled = True txtjml.Enabled = True txtjnsby.BackColor = &H80000005 txtjml.BackColor = &H80000005 End Sub Private Sub SiapIsi2() txtkodeby.Enabled = True txtjnsby.Enabled = True txtjml.Enabled = True txtkodeby.BackColor = &H80000005 txtjnsby.BackColor = &H80000005 txtjml.BackColor = &H80000005 End Sub Private Sub isitabeljenisbiaya() Rsbiaya!kodepkt = txtkodepkt.Text Rsbiaya!kodeby = txtkodeby.Text Rsbiaya!jnsby = txtjnsby.Text Rsbiaya!jmlby = txtjml.Text Rsbiaya!ta = txtthn.Text End Sub Private Sub AktifTombol() cmdsimpan.Enabled = True cmdedit.Enabled = True cmdhapus.Enabled = True End Sub Private Sub tutuptombol() cmdhapus.Enabled = False cmdedit.Enabled = False End Sub Private Sub isiformjenisbiaya() txtjnsby.Text = Rsbiaya!jnsby txtjml.Text = Rsbiaya!jmlby End Sub Private Sub Validasi() Valid = False If txtkodeby.Text = Empty Then x = MsgBox("Kode Biaya harus diisi", 0 + 16, "konfirmasi") Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
12
txtkodeby.Text = "" txtkodeby.SetFocus Exit Sub ElseIf txtjnsby.Text = Empty Then x = MsgBox("jnsby Biaya harus diisi", 0 + 16, "konfirmasi") txtjnsby.Text = "" txtjnsby.SetFocus Exit Sub ElseIf txtjml.Text = Empty Then x = MsgBox("Jumlah Biaya harus diisi", 0 + 16, "konfirmasi") txtjml.Text = "" txtjml.SetFocus Exit Sub
End If Valid = True End Sub Private Sub Tampildata() Set RsTampil = Nothing RsTampil.Open "Select kodeby,jnsby,jmlby from " & _ " tblbiaya where kodepkt ='" & txtkodepkt & "'", Koneksi Grid1.Refresh Set Grid1.DataSource = RsTampil Grid1.Columns(0).Width = 1500 Grid1.Columns(1).Width = 4000 Grid1.Columns(2).Width = 1250 Grid1.Columns(0).Alignment = dbgCenter Grid1.Columns(2).Alignment = dbgRight Grid1.Columns(2).NumberFormat = "#,###,###" Grid1.Columns(0).Caption = "KODE BIAYA" Grid1.Columns(1).Caption = "JENIS BIAYA" Grid1.Columns(2).Caption = "JUMLAH" End Sub Private Sub Form_Activate() mdmenuutama.Enabled = False cmdsimpan.Enabled = False End Sub Private Sub txtkodepkt_Click() txtkodepkt.Text = "" txtjnsby.Text = "" blankform1 Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
13
tidaksiapisi Tampildata End Sub Private Sub Up1_Change() txtthn.Text = Up1 End Sub Private Sub Form_Load() BukaDatabase blankform1 tidaksiapisi tutuptombol txtkodepkt.Text = "" cmdsimpan.Caption = "&Tambah" Up1.Value = Year(Date) End Sub Private Sub aturtahun() txtthn.Text = Trim(Str(Year(Date))) + "/" + Trim(Str(Year(Date) + 1)) End Sub Private Sub Form_Unload(Cancel As Integer) Koneksi.Close End Sub Private Sub txtkodepkt_keydown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyF1 Then txtkodepkt.Text = "" Sql = "Select namapkt,kodepkt from tblpaket where kodepkt like '" & txtkodepkt & "%' order by kodepkt" Ada = True frminfo.Caption = " >>> Info Data Paket Tahun” & txtthn & "<<<" frminfo.Grid1.Columns(0).Caption = "NAMA PAKET" frminfo.Grid1.Columns(1).Caption = "KODE PAKET" frminfo.Show vbModal, Me Ada = False txtkodepkt.Text = frminfo.Kode txtkodepkt_Lostfocus End If If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txtkodepkt_Lostfocus() ckode = Trim(txtkodepkt.Text) If ckode = Empty Then Exit Sub Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
14
End If If Rspaket.RecordCount > 0 Then Rspaket.MoveFirst End If If Len(ckode) >= 3 Then Rspaket.Find ("kodepkt = '" & ckode & "'") If Rspaket.EOF Then x = MsgBox("Maaf, Paket dengan Kode <<" & txtkodepkt.Text & ">> tsb belum ada !", 0 + 16, "Konfirmasi") txtkodepkt.Text = "" txtkodepkt.SetFocus Exit Sub Else txtnamapkt.Text = Rspaket!namapkt + " / " + Rspaket!Lamabljr Blankform2 SiapIsi2 txtkodeby.SetFocus Ada1 = False cmdsimpan.Caption = "&Tambah" End If End If Tampildata Aturkodeby End Sub Public Sub Batal() txtkodeby.Enabled = True txtkodeby.BackColor = &H80000005 txtjnsby.Text = "" txtjml.Text = "" txtjnsby.Enabled = False txtjml.Enabled = False End Sub Private Sub CmdSimpan_Click() If cmdsimpan.Caption = "&Tambah" Then Batal Aturkodeby txtkodeby.SetFocus Exit Sub End If Validasi If Valid = True Then If Ada1 = False Then Rsbiaya.AddNew isitabeljenisbiaya Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
15
Rsbiaya.Update Else Koneksi.Execute "update tblbiaya set jnsby= '" + txtjnsby + "', " & _ " jmlby= '" + txtjml + "' where kodeby='" + txtkodeby + "'" End If cmdsimpan.Caption = "&Tambah" Else cmdsimpan.Caption = "&Simpan" End If Rsbiaya.Requery Tampildata Aturkodeby End Sub Private Sub CmdBatal_Click() txtkodepkt.Text = "" blankform1 tidaksiapisi txtkodepkt.Enabled = True txtkodepkt.BackColor = &H80000005 txtkodepkt.SetFocus cmdsimpan.Caption = "&Tambah" cmdsimpan.Enabled = False tutuptombol Tampildata End Sub Private Sub cmdedit_click() tutuptombol Ada1 = True SiapIsi1 txtkodepkt.Enabled = False txtkodepkt.BackColor = &H80000016 cmdsimpan.Caption = "&Simpan" txtjnsby.SetFocus End Sub Private Sub CmdHapus_Click() ckode = Trim(txtkodeby.Text) Rspembayaran.Find ("kodeby='" & ckode & "'"), , adSearchForward, 1 If Not Rspembayaran.EOF Then x = MsgBox("Jenis Biaya tersebut tidak dapat dihapus", 0 + 16, "konfirmasi") Blankform2 txtkodeby.Enabled = True txtkodeby.BackColor = &H80000005 txtkodeby.SetFocus Exit Sub Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
16
Else Y = MsgBox("Benar anda ingin hapus ???", vbYesNo + vbQuestion + vbDefaultButton2, "konfirmasi") Select Case Y Case vbYes Koneksi.Execute "delete * from tblbiaya where kodeby ='" & ckode & "'" Case vbNo End Select End If CmdBatal_Click Rsbiaya.Requery Tampildata End Sub Private Sub CmdKeluar_Click() Unload Me mdmenuutama.Enabled = True End Sub Private Sub Grid1_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then If Rsbiaya.RecordCount > 0 Then txtkodeby.Text = Grid1.Columns(0) txtkodeby_Lostfocus End If End If End Sub Private Sub txtjml_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txtjnsby_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txtkodeby_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyF1 Then txtkodeby.Text = "" Sql = "Select jnsby,kodeby from tblbiaya Where kodepkt ='" & txtkodepkt & "' and ta='" & txtthn & "' order by kodeby"
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
17 Ada = True frminfo.Caption = " >>> Info Data Jenis Biaya Tahun" & txtthn & "<<<" frminfo.Show vbModal, Me Ada = False txtkodeby.Text = frminfo.Kode txtkodeby_Lostfocus End If If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txtkodeby_Lostfocus() ckode = Trim(txtkodeby.Text) If ckode = Empty Then Exit Sub End If If Rsbiaya.RecordCount > 0 Then Rsbiaya.MoveFirst End If Rsbiaya.Find ("kodeby = '" & ckode & "'") If Rsbiaya.EOF Then SiapIsi1 txtjnsby.SetFocus cmdsimpan.Enabled = True cmdsimpan.Caption = "&Simpan" Ada1 = False Else isiformjenisbiaya tidaksiapisi cmdedit.Enabled = True cmdhapus.Enabled = True cmdsimpan.Enabled = True cmdsimpan.Caption = "&Tambah" Ada1 = True End If Tampildata End Sub Private Sub txtjml_keypress(keyascii As Integer) If Not (keyascii >= Asc("0") And keyascii <= Asc("9") Or _ keyascii = vbKeyBack) Then keyascii = 0 End If End Sub Private Sub Aturkodeby() Set RsTampil = Nothing RsTampil.Open "Select * From tblbiaya Where kodepkt='" & txtkodepkt & "'" & _ " and Ta='" & txtthn & "' order by kodeby", Koneksi cmk = Mid(txtthn.Text, 3, 2) + "-" txtkodeby.Text = cmk End Sub Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
18
Design Form seperti gambar dibawah ini, dan berikan nama FrmKelas Form Data Kelas
Ketik Listing dibawah ini ! Public Ada1, Valid As Boolean Dim RsTampil As New ADODB.Recordset Private Sub blankform1() txtnamakls.Text = "" txtmulaibljr.Text = "" txtselesaibljr.Text = "" txtjmlsiswa.Text = "" End Sub Private Sub tidaksiapisi() txtnamakls.Enabled = False txtmulaibljr.Enabled = False txtselesaibljr.Enabled = False txtjmlsiswa.Enabled = False txtnamakls.BackColor = &H80000016 txtmulaibljr.BackColor = &H80000016 txtselesaibljr.BackColor = &H80000016 txtjmlsiswa.BackColor = &H80000016 End Sub Private Sub SiapIsi1() txtnamakls.Enabled = True Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
19
txtmulaibljr.Enabled = True txtselesaibljr.Enabled = True txtjmlsiswa.Enabled = True txtnamakls.BackColor = &H80000005 txtmulaibljr.BackColor = &H80000005 txtselesaibljr.BackColor = &H80000005 txtjmlsiswa.BackColor = &H80000005 End Sub Private Sub isitabelkelas() Rskelas!kodekls = txtkode.Text Rskelas!namakls = txtnamakls.Text Rskelas!Mulaibljr = txtmulaibljr.Text Rskelas!selesaibljr = txtselesaibljr.Text Rskelas!jmlsiswa = txtjmlsiswa.Text End Sub Private Sub AktifTombol() cmdsimpan.Enabled = True cmdedit.Enabled = True cmdhapus.Enabled = True End Sub Private Sub tutuptombol() cmdhapus.Enabled = False cmdedit.Enabled = False End Sub Private Sub isiformkelas() txtnamakls.Text = Rskelas!namakls txtmulaibljr.Text = Rskelas!Mulaibljr txtselesaibljr.Text = Rskelas!selesaibljr txtjmlsiswa.Text = Rskelas!jmlsiswa End Sub Private Sub Validasi() Valid = False If txtkode.Text = Empty Then x = MsgBox("Kode Jurusan harus diisi", 0 + 16, "konfirmasi") txtkode.Text = "" txtkode.SetFocus Exit Sub ElseIf txtnamakls.Text = Empty Then x = MsgBox("namakls Jurusan harus diisi", 0 + 16, "konfirmasi") txtnamakls.Text = "" txtnamakls.SetFocus Exit Sub ElseIf txtmulaibljr.Text = Empty Then x = MsgBox("Jam Mulai Belajar harus diisi", 0 + 16, "konfirmasi") Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
20
txtmulaibljr.Text = "" txtmulaibljr.SetFocus Exit Sub ElseIf txtselesaibljr.Text = Empty Then x = MsgBox("Jam Selesai Belajar harus diisi", 0 + 16, "konfirmasi") txtselesaibljr.Text = "" txtselesaibljr.SetFocus Exit Sub ElseIf txtjmlsiswa.Text = Empty Then x = MsgBox("Jumlah siswa harus diisi", 0 + 16, "konfirmasi") txtjmlsiswa.Text = "" txtjmlsiswa.SetFocus Exit Sub End If Valid = True End Sub Private Sub Tampildata() Set RsTampil = Nothing RsTampil.Open "select * from tblkelas order by kodekls ", Koneksi, adOpenDynamic, adLockOptimistic Set Grid1.DataSource = RsTampil Grid1.Columns(0).Width = 1500 Grid1.Columns(1).Width = 3000 Grid1.Columns(2).Width = 1250 Grid1.Columns(3).Width = 1250 Grid1.Columns(4).Width = 1250 Grid1.Columns(0).Alignment = dbgCenter Grid1.Columns(2).Alignment = dbgCenter Grid1.Columns(3).Alignment = dbgCenter Grid1.Columns(4).Alignment = dbgCenter Grid1.Columns(0).Caption = "KODE KELAS" Grid1.Columns(1).Caption = "NAMA KELAS" Grid1.Columns(2).Caption = "JAM MULAI BELAJAR" Grid1.Columns(3).Caption = "JAM MULAI SELESAI" Grid1.Columns(4).Caption = "JUMLAH SISWA" End Sub Private Sub Form_Activate() mdmenuutama.Enabled = False End Sub Private Sub Form_Load() BukaDatabase blankform1 Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
21
tidaksiapisi tutuptombol txtkode.Text = "" cmdsimpan.Caption = "&Tambah" Tampildata End Sub Private Sub Form_Unload(Cancel As Integer) Koneksi.Close End Sub Private Sub txtkode_Click() txtnamakls.Text = "" txtmulaibljr.Text = "" txtselesaibljr.Text = "" txtjmlsiswa.Text = "" End Sub Private Sub txtkode_Lostfocus() ckode = Trim(txtkode.Text) If ckode = Empty Then Exit Sub End If If Rskelas.RecordCount > 0 Then Rskelas.MoveFirst End If Rskelas.Find ("kodekls = '" & ckode & "'") If Rskelas.EOF Then blankform1 SiapIsi1 txtnamakls.SetFocus Ada1 = False tutuptombol cmdsimpan.Caption = "&Simpan" Else tidaksiapisi isiformkelas cmdedit.Enabled = True cmdhapus.Enabled = True Ada1 = True End If End Sub Private Sub CmdSimpan_Click() If cmdsimpan.Caption = "&Tambah" Then CmdBatal_Click Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
22
Exit Sub End If Validasi If Valid = True Then If Ada1 = False Then Rskelas.AddNew isitabelkelas Rskelas.Update Else Koneksi.Execute "update tblkelas set namakls='" + txtnamakls + "'," & "mulaibljr='" + txtmulaibljr + "', selesaibljr='" + txtselesaibljr + "', jmlsiswa='" + txtjmlsiswa + "' where kodekls ='" + txtkode + "'" End If cmdsimpan.Caption = "&Tambah" Else cmdsimpan.Caption = "&Simpan" End If Rskelas.Requery Tampildata End Sub Private Sub CmdBatal_Click() blankform1 tidaksiapisi txtkode.Enabled = True txtkode.BackColor = &H80000005 txtkode.SetFocus cmdsimpan.Caption = "&Tambah" tutuptombol End Sub Private Sub cmdedit_click() tutuptombol Ada1 = True SiapIsi1 txtkode.Enabled = False txtkode.BackColor = &H80000016 cmdsimpan.Caption = "&Simpan" txtnamakls.SetFocus End Sub Private Sub CmdHapus_Click() ckode = Trim(txtkode.Text) Rssiswa.Find ("kodekls='" & ckode & "'"), , adSearchForward, 1 Rstunggu.Find ("kodekls='" & ckode & "'"), , adSearchForward, 1
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
23
If Not Rssiswa.EOF Then x = MsgBox("maaf kode jurusan tersebut tidak dapat dihapus", 0 + 16, "konfirmasi") txtkode.SetFocus Exit Sub ElseIf Not Rstunggu.EOF Then x = MsgBox("maaf kode jurusan tersebut tidak dapat dihapus", 0 + 16, "konfirmasi") txtkode.SetFocus Exit Sub Else Y = MsgBox("Benar anda ingin hapus ???", vbYesNo + vbQuestion + vbDefaultButton2, "konfirmasi") Select Case Y Case vbYes Koneksi.Execute "delete * from tblkelas where kodekls ='" & ckode & "'" Case vbNo End Select End If CmdBatal_Click Rskelas.Requery Tampildata End Sub Private Sub CmdKeluar_Click() Unload Me mdmenuutama.Enabled = True End Sub Private Sub Grid1_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then If Rskelas.RecordCount > 0 Then txtkode.Text = Grid1.Columns(0) txtkode_Lostfocus End If End If End Sub Private Sub txtkode_keydown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txtselesaibljr_keydown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
24
Private Sub txtjmlsiswa_keydown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txtjmlsiswa_keypress(keyascii As Integer) If Not (keyascii >= Asc("0") And keyascii <= Asc("9") Or _ keyascii = vbKeyBack) Then keyascii = 0 End If End Sub Private Sub txtmulaibljr_keydown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txtnamakls_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
25
Design Form seperti gambar dibawah ini, dan berikan nama FrmCalonSiswa Form Calon Siswa
Ketik Listing dibawah ini ! Public Ada, Ada1, Valid As Boolean Public Sql, cno, cnama As String Dim RsTampil As New ADODB.Recordset Private Sub blankform1() txtnamapkt.Text = "" txtalamat.Text = "" txtno_daftar.Text = "" txtnama_calon.Text = "" cbokelamin.Text = "" cbopendidikan.Text = "" txttelp.Text = "" txtkodekls.Text = "" txtnamakls.Text = "" End Sub Private Sub Blankform2() txtno_daftar.Text = "" txtalamat.Text = "" txtnama_calon.Text = "" cbopendidikan.Text = "" cbokelamin.Text = "" Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
26
txttelp.Text = "" End Sub Private Sub tidaksiapisi() txtnamapkt.Enabled = False txtkodekls.Enabled = False txtnamakls.Enabled = False txtno_daftar.Enabled = False txtalamat.Enabled = False txtnama_calon.Enabled = False cbopendidikan.Enabled = False dtpdaftar.Enabled = False cbokelamin.Enabled = False txttelp.Enabled = False txtalamat.BackColor = &H80000016 txtnamapkt.BackColor = &H80000016 txtno_daftar.BackColor = &H80000016 txtnama_calon.BackColor = &H80000016 dtpdaftar.CalendarBackColor = &H80000016 cbokelamin.BackColor = &H80000016 cbopendidikan.BackColor = &H80000016 txttelp.BackColor = &H80000016 cbopendidikan.BackColor = &H80000016 End Sub Private Sub SiapIsi1() txtnama_calon.Enabled = True txtalamat.Enabled = True cbokelamin.Enabled = True cbopendidikan.Enabled = True txttelp.Enabled = True dtpdaftar.Enabled = True txtalamat.BackColor = &H80000005 txtnamapkt.BackColor = &H80000005 cbopendidikan.BackColor = &H80000005 txtno_daftar.BackColor = &H80000005 txtnama_calon.BackColor = &H80000005 cbokelamin.BackColor = &H80000005 txttelp.BackColor = &H80000005 End Sub Private Sub SiapIsi2() txtno_daftar.Enabled = True txtno_daftar.BackColor = &H80000016 txtalamat.BackColor = &H80000016 cbopendidikan = &H80000016 txtnamapkt.BackColor = &H80000016 Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
27
txtno_daftar.BackColor = &H80000016 txtnama_calon.BackColor = &H80000016 cbokelamin.BackColor = &H80000016 dtpdaftar.CalendarBackColor = &H80000016 txttelp.BackColor = &H80000016 End Sub Private Sub isitabelcalon() Rstunggu!kodepkt = txtkodepkt.Text Rstunggu!nodaftar = txtno_daftar.Text Rstunggu!nama = txtnama_calon.Text Rstunggu!jns_kel = cbokelamin.Text Rstunggu!tgldaftar = dtpdaftar Rstunggu!pendidikan = cbopendidikan.Text Rstunggu!notelp = txttelp.Text Rstunggu!thn_masuk = txtthn.Text Rstunggu!ket = "Ok" Rstunggu!alamat = txtalamat.Text Rstunggu!kodekls = txtkodekls.Text End Sub Private Sub AktifTombol() cmdsimpan.Enabled = True cmdedit.Enabled = True cmdhapus.Enabled = True End Sub Private Sub tutuptombol() cmdhapus.Enabled = False cmdedit.Enabled = False cmdsimpan.Enabled = False End Sub Private Sub isiformsiswa() txtnama_calon.Text = Rstunggu!nama dtpdaftar = Rstunggu!tgldaftar cbokelamin.Text = Rstunggu!jns_kel txttelp.Text = Rstunggu!notelp cbopendidikan.Text = Rstunggu!pendidikan txtthn.Text = Rstunggu!thn_masuk txtalamat.Text = Rstunggu!alamat End Sub Private Sub Validasi() Valid = False If txtno_daftar.Text = Empty Then x = MsgBox("Nomor Daftar Siswa harus diisi", 0 + 16, "konfirmasi") txtno_daftar.Text = "" Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
28
txtno_daftar.SetFocus Exit Sub ElseIf txtnama_calon.Text = Empty Then x = MsgBox("Nama Calon harus diisi", 0 + 16, "konfirmasi") txtnama_calon.Text = "" txtnama_calon.SetFocus Exit Sub ElseIf cbokelamin.Text = Empty Then x = MsgBox("Jenis Kelamin harus diisi", 0 + 16, "konfirmasi") cbokelamin.Text = "" cbokelamin.SetFocus ElseIf txttelp.Text = Empty Then x = MsgBox("Harus mengisi nomor Telp atau HP untuk bisa dihubungi jika ada kepentingan", 0 + 16, "konfirmasi") txttelp.Text = "" txttelp.SetFocus Exit Sub ElseIf cbopendidikan.Text = Empty Then x = MsgBox("Asal sekolah harus diisi", 0 + 16, "konfirmasi") cbopendidikan.Text = "" cbopendidikan.SetFocus Exit Sub ElseIf txtkodepkt.Text = Empty Then x = MsgBox("Kode Paket harus diisi", 0 + 16, "konfirmasi") txtkodepkt.Text = "" txtkodepkt.SetFocus Exit Sub ElseIf txtkodekls.Text = Empty Then x = MsgBox("Kode Kelas harus diisi", 0 + 16, "konfirmasi") txtkodekls.Text = "" txtkodekls.SetFocus Exit Sub End If Valid = True End Sub Private Sub Tampildata() Set RsTampil = Nothing RsTampil.Open "Select nodaftar,Nama,jns_kel,alamat,tgldaftar from " & _ " tbltunggu where kodepkt ='" & txtkodepkt & "'and thn_masuk ='" & txtthn & "'and ket='Ok' order by nodaftar,tgldaftar", Koneksi Grid1.Refresh Set Grid1.DataSource = RsTampil Grid1.Columns(0).Width = 1500 Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
29
Grid1.Columns(1).Width = 2750 Grid1.Columns(2).Width = 1500 Grid1.Columns(3).Width = 1500 Grid1.Columns(4).Width = 1500 Grid1.Columns(0).Alignment = dbgCenter Grid1.Columns(4).Alignment = dbgCenter Grid1.Columns(0).Caption = "NO. DAFTAR" Grid1.Columns(1).Caption = "NAMA SISWA" Grid1.Columns(2).Caption = "JENIS KELAMIN" Grid1.Columns(3).Caption = "ALAMAT" Grid1.Columns(4).Caption = "TANGGAL DAFTAR" End Sub Private Sub Form_Activate() mdmenuutama.Enabled = False Grid1.Enabled = False End Sub Private Sub Grid1_Click() If RsTampil.RecordCount > 0 Then cmdhapus.Enabled = True Else cmdhapus.Enabled = False End If If txtnama_calon.Text = Empty Then cmdsimpan.Caption = "&Tambah" End If If txtnama_calon.Text = Empty Then cmdhapus.Enabled = True Grid1.SetFocus End If txtnama_calon.Enabled = False cbokelamin.Enabled = False dtpdaftar.Enabled = False cbopendidikan.Enabled = False txtalamat.Text = "" txttelp.Enabled = False End Sub Private Sub txtkode_Click() txtkode.Text = "" txtnamapkt.Text = "" txtkodekls.Text = "" txtnamakls.Text = "" Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
30
Blankform2 tidaksiapisi txtkode.SetFocus Tampildata End Sub Private Sub cbopendidikan_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txtnama_calon_KeyPress(keyascii As Integer) keyascii = Asc(UCase(Chr(keyascii))) End Sub Private Sub Up1_Change() txtthn.Text = Up1 End Sub Private Sub Form_Load() BukaDatabase blankform1 tidaksiapisi tutuptombol txtkodepkt.Text = "" cmdsimpan.Caption = "&Tambah" cbokelamin.List(0) = "Laki-Laki" cbokelamin.List(1) = "Perempuan" cbopendidikan.List(0) = "SD" cbopendidikan.List(1) = "SMP" cbopendidikan.List(2) = "SMA" cbopendidikan.List(3) = "SMK" cbopendidikan.List(4) = "MA" cbopendidikan.List(5) = "D1" cbopendidikan.List(6) = "D2" cbopendidikan.List(7) = "D3" cbopendidikan.List(8) = "S1" Up1.Value = Year(Date) dtpdaftar = Date txtthn.Text = Up1 End Sub Private Sub Form_Unload(Cancel As Integer) Koneksi.Close End Sub Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
31
Private Sub txtkodepkt_keydown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyF1 Then txtkodepkt.Text = "" Sql = "Select Namapkt,kodepkt,LamaBljr from tblpaket where kodepkt like '" & txtkodepkt & "%' order by kodepkt" Ada = True frminfo.Caption = " >>> Info Data Paket Tahun " & txtthn & "<<<" frminfo.Grid1.Columns(0).Caption = "KODE PAKET" frminfo.Grid1.Columns(1).Caption = "NAMA PAKET" frminfo.Grid1.Columns(2).Caption = "LAMA BELAJAR" frminfo.Show vbModal, Me Ada = False txtkodepkt.Text = frminfo.Kode txtkodepkt_Lostfocus End If If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txtkodepkt_Lostfocus() ckode = Trim(txtkodepkt.Text) If ckode = Empty Then Exit Sub End If If Rspaket.RecordCount > 0 Then Rspaket.MoveFirst End If If Len(ckode) >= 3 Then Rspaket.Find ("kodepkt = '" & ckode & "'") If Rspaket.EOF Then x = MsgBox("Maaf, Paket dengan Kode <<" & txtkodepkt.Text & ">> tsb belum ada !", 0 + 16, "Konfirmasi") txtkodepkt.Text = "" txtkodepkt.SetFocus Exit Sub Else txtnamapkt.Text = Rspaket!namapkt + " / " + Rspaket!Lamabljr txtkodekls.Enabled = True txtkodekls.SetFocus Ada1 = False cmdsimpan.Caption = "&Tambah" End If End If End Sub Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
32
Private Sub txtkodekls_keydown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyF1 Then txtkodekls.Text = "" Sql = "Select Namakls,kodekls,Mulaibljr from tblkelas where kodekls like '" & txtkodekls & "%' order by kodekls" Ada = True frminfo.Caption = " >>> Info Data Kelas Tahun " & txtthn & "<<<" frminfo.Grid1.Columns(0).Caption = "KODE KELAS" frminfo.Grid1.Columns(1).Caption = "NAMA KELAS" frminfo.Grid1.Columns(2).Caption = "MULAI BELAJAR" frminfo.Show vbModal, Me Ada = False txtkodekls.Text = frminfo.Kode txtkodekls_Lostfocus End If If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txtkodekls_Lostfocus() ckode = Trim(txtkodekls.Text) If ckode = Empty Then Exit Sub End If If Rskelas.RecordCount > 0 Then Rskelas.MoveFirst End If If Len(ckode) >= 3 Then Rskelas.Find ("kodekls = '" & ckode & "'") If Rskelas.EOF Then x = MsgBox("Maaf, Kelas dengan Kode <<" & txtkodepkt.Text & ">> tsb belum ada !", 0 + 16, "Konfirmasi") txtkodekls.Text = "" txtkodekls.SetFocus Exit Sub Else txtnamakls.Text = Rskelas!namakls + " / " + " Mulai Belajar : " + Rskelas!Mulaibljr Blankform2 SiapIsi2 cbopendidikan.Text = "" txtno_daftar.Enabled = True txtno_daftar.SetFocus Aturno_daftar Ada1 = False Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
33
cmdsimpan.Caption = "&Tambah" End If End If Tampildata txtjml_siswa.Text = RsTampil.RecordCount Aturno_daftar Grid1.Enabled = True End Sub Public Sub Batal() txtno_daftar.Enabled = True txtno_daftar.BackColor = &H80000005 txtnama_calon.Text = "" cbokelamin.Text = "" cbopendidikan.Text = "" txttelp.Text = "" txtalamat.Text = "" cbopendidikan.Enabled = False txtalamat.Enabled = False txtnama_calon.Enabled = False cbokelamin.Enabled = False txttelp.Enabled = False cmdsimpan.Enabled = False End Sub Private Sub CmdSimpan_Click() If cmdsimpan.Caption = "&Tambah" Then Batal Aturno_daftar txtno_daftar.SetFocus Exit Sub End If Validasi If Valid = True Then If Ada1 = False Then Rstunggu.AddNew isitabelcalon Rstunggu.Update Else isitabelcalon Rstunggu.Update End If cmdsimpan.Caption = "&Tambah" Else cmdsimpan.Caption = "&Simpan" End If Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
34
Rstunggu.Requery Tampildata Aturno_daftar txtjml_siswa.Text = RsTampil.RecordCount End Sub Private Sub CmdBatal_Click() txtkodepkt.Text = "" txtjml_siswa.Text = "" blankform1 tidaksiapisi txtkodepkt.Enabled = True txtkodepkt.BackColor = &H80000005 txtkodekls.BackColor = &H80000005 txtkodepkt.SetFocus cmdsimpan.Caption = "&Tambah" tutuptombol Tampildata End Sub Private Sub cmdedit_click() tutuptombol cmdsimpan.Enabled = True Ada1 = True SiapIsi1 txtkodepkt.Enabled = False txtkodepkt.BackColor = &H80000016 cmdsimpan.Caption = "&Simpan" txtnama_calon.SetFocus End Sub Private Sub CmdHapus_Click() cmdhapus.Enabled = False cno = Grid1.Columns(0) cnama = Grid1.Columns(1) Y = MsgBox("benar anda ingin batalkan calon Siswa dari pendaftaran ???", vbYesNo + vbQuestion + vbDefaultButton2, "Konfirmasi") Select Case Y Case vbYes Koneksi.Execute "Update tbltunggu set Ket='Batal' where nodaftar='" & cno & "'" 'Koneksi.Execute "Update nomor_kamar set status_kamar ='Kosong' where no_kamar ='" & cno & "'" txtno_daftar.SetFocus cmdhapus.Enabled = False Case vbNo cmdsimpan.Caption = "&Tambah" Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
35
cmdsimpan.Enabled = True CmdSimpan_Click cmdhapus.Enabled = False cmdbatal.Enabled = True End Select Tampildata Aturno_daftar txtjml_siswa.Text = RsTampil.RecordCount batal1 End Sub Private Sub CmdKeluar_Click() Unload Me mdmenuutama.Enabled = True End Sub Private Sub Grid1_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then If Rstunggu.RecordCount > 0 Then txtno_daftar.Text = Grid1.Columns(0) txtno_daftar_Lostfocus End If End If End Sub Private Sub txtnama_calon_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub dtpdaftar_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub cbokelamin_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub Txttelp_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
36
Private Sub Txtalamat_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub
Private Sub txtno_daftar_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyF1 Then txtno_daftar.Text = "" Sql = "Select Alamat,nodaftar,nama from tbltunggu where kodepkt ='" & txtkodepkt & "' and thn_masuk='" & txtthn & "' and ket='Masuk' order by no_daftar,tgldaftar" Ada = True frminfo.Caption = " >>> Info Data Calon Siswa Tahun " & txtthn & " <<<" frminfo.Show vbModal, Me Ada = False txtno_daftar.Text = frminfo.Kode txtno_daftar_Lostfocus End If If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txtno_daftar_Lostfocus() ckode = Trim(txtno_daftar.Text) If ckode = Empty Then Exit Sub End If If Rstunggu.RecordCount > 0 Then Rstunggu.MoveFirst End If Set Rstunggu = Nothing Rstunggu.Open "[tbltunggu] where kodepkt = '" & txtkodepkt & "'" & _ "and nodaftar = '" & txtno_daftar & " ' And " & _ "kodepkt='" & txtkodepkt & "' and tbltunggu.ket='Ok' ", Koneksi, adOpenDynamic, adLockOptimistic If Rstunggu.EOF Then SiapIsi1 cbopendidikan.Text = "" txtalamat.Text = "" txtnama_calon.SetFocus cmdsimpan.Enabled = True cmdsimpan.Caption = "&Simpan" Ada1 = False Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
37
Set Rstunggu = Nothing Rstunggu.Open "[tbltunggu] where kodepkt = '" & txtkodepkt & "'" & _ "and nodaftar = '" & txtno_daftar & " ' And " & _ "kodepkt='" & txtkodepkt & "' and ket='Batal' ", Koneksi, adOpenDynamic, adLockOptimistic If Not Rstunggu.EOF Then x = MsgBox("Maaf, No.Daftar tersebut sudah dipakai oleh calon siswa yang statusnya
!", 0 + 64, "Konfirmasi") txtno_daftar.Enabled = True txtno_daftar.SetFocus cmdsimpan.Caption = "&Tambah" Aturno_daftar End If Else isiformsiswa tidaksiapisi cmdedit.Enabled = True cmdsimpan.Enabled = True cmdsimpan.Caption = "&Tambah" Ada1 = True End If Tampildata End Sub Private Sub Aturno_daftar() Set RsTampil = Nothing RsTampil.Open "Select * From tbltunggu Where kodepkt='" & txtkodepkt & "'" & _ " and Thn_Masuk='" & txtthn & "' order by nodaftar", Koneksi cnou = Trim(Right(txtkodepkt.Text, 2)) + Trim(Right(txtthn.Text, 2)) If RsTampil.RecordCount = 0 Then cno = "001" Else RsTampil.MoveLast Na = Val(Right(RsTampil!nodaftar, 3)) + 1 If Len(Na) = 1 Then cno = "00" + Trim(Str(Na)) ElseIf Len(Na) = 2 Then cno = "0" + Trim(Str(Na)) ElseIf Len(Na) = 3 Then cno = Trim(Str(Na)) End If End If txtno_daftar.Text = cnou + cno End Sub Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
38
Private Sub batal1() txtnama_calon.Text = "" cbokelamin.Text = "" cbopendidikan.Text = "" txtalamat.Text = "" txttelp.Text = "" End Sub Private Sub Grid1_KeyPress(keyascii As Integer) cno = Grid1.Columns(0) cnama = Grid1.Columns(1) End Sub Design Form seperti gambar dibawah ini, dan berikan nama FrmSiswa Form Data Siswa
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
39
Ketik Listing dibawah ini ! Public Ada, Ada1, Valid As Boolean Public Sql As String Dim RsTampil As New ADODB.Recordset Private Sub blankform1() txtnama.Text = "" txttempat.Text = "" cbokelamin.Text = "" cbostatus.Text = "" cboagama.Text = "" txtasal.Text = "" txtsekarang.Text = "" txttelp.Text = "" cbopekerjaan.Text = "" cbopendidikan.Text = "" cboagama.Text = "" txtstatus.Text = "" 'txtjmlsiswa.Text = "" txtkodepkt.Text = "" txtkodekls.Text = "" txtnamapkt.Text = "" txtnamakls.Text = "" End Sub Private Sub Blankform2() txtnis.Text = "" txtnama.Text = "" txttempat.Text = "" cbokelamin.Text = "" cbostatus.Text = "" txtasal.Text = "" cboagama.Text = "" txtasal.Text = "" txtsekarang.Text = "" txttelp.Text = "" cbopendidikan.Text = "" cboagama.Text = "" txtstatus.Text = "" End Sub Private Sub tidaksiapisi() txtnama.Enabled = False dtpdaftar.Enabled = False txtnama.Enabled = False Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
40
txttempat.Enabled = False txtasal.Enabled = False dtplahir.Enabled = False cbokelamin.Enabled = False cbostatus.Enabled = False cboagama.Enabled = False txtasal.Enabled = False txtsekarang.Enabled = False txttelp.Enabled = False cbopendidikan.Enabled = False cbopekerjaan.Enabled = False cboagama.Enabled = False txtstatus.Enabled = False txtkodekls.Enabled = False txtkodepkt.Enabled = False txtnamakls.Enabled = False txtnamapkt.Enabled = False txtnama.BackColor = &H80000016 txtkodepkt.BackColor = &H80000016 txtnamapkt.BackColor = &H80000016 txtkodekls.BackColor = &H80000016 txtnamakls.BackColor = &H80000016 txttempat.BackColor = &H80000016 dtplahir.CalendarBackColor = &H80000016 cbopekerjaan.BackColor = &H80000016 cbokelamin.BackColor = &H80000016 cbostatus.BackColor = &H80000016 cboagama.BackColor = &H80000016 txtasal.BackColor = &H80000016 txtsekarang.BackColor = &H80000016 txttelp.BackColor = &H80000016 cbopendidikan.BackColor = &H80000016 cboagama.BackColor = &H80000016 txtstatus.BackColor = &H80000016 End Sub Private Sub SiapIsi1() txtnama.Enabled = True txttempat.Enabled = True cbokelamin.Enabled = True txtasal.Enabled = True cbostatus.Enabled = True cboagama.Enabled = True txtasal.Enabled = True txtsekarang.Enabled = True Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
41
txttelp.Enabled = True cbopendidikan.Enabled = True cbopekerjaan.Enabled = True cboagama.Enabled = True dtplahir.Enabled = True dtpdaftar.Enabled = True txtstatus.Enabled = True txtkodekls.Enabled = True txtkodepkt.Enabled = True txtnama.BackColor = &H80000005 txtnis.BackColor = &H80000005 txtnama.BackColor = &H80000005 txttempat.BackColor = &H80000005 cbokelamin.BackColor = &H80000005 cbostatus.BackColor = &H80000005 cboagama.BackColor = &H80000005 cbopekerjaan.BackColor = &H80000005 txtasal.BackColor = &H80000005 txtsekarang.BackColor = &H80000005 txttelp.BackColor = &H80000005 cbopendidikan.BackColor = &H80000005 cboagama.BackColor = &H80000005 txtstatus.BackColor = &H80000005 txtkodekls.BackColor = &H80000005 txtnamakls.BackColor = &H80000005 txtkodepkt.BackColor = &H80000005 txtnamapkt.BackColor = &H80000005 End Sub Private Sub SiapIsi2() txtnis.Enabled = True txtnis.BackColor = &H80000016 txtnama.BackColor = &H80000016 txtnis.BackColor = &H80000016 txtnama.BackColor = &H80000016 txttempat.BackColor = &H80000016 cbokelamin.BackColor = &H80000016 cbostatus.BackColor = &H80000016 cboagama.BackColor = &H80000016 txtasal.BackColor = &H80000016 txtsekarang.BackColor = &H80000016 txttelp.BackColor = &H80000016 cbopendidikan.BackColor = &H80000016 cboagama.BackColor = &H80000016 txtstatus.BackColor = &H80000016 Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
End Sub Private Sub isitabelsiswa() Rssiswa!nis = txtnis.Text Rssiswa!nama = txtnama.Text Rssiswa!t4lahir = txttempat.Text Rssiswa!tgllahir = dtplahir Rssiswa!jnskel = cbokelamin.Text Rssiswa!Status = cbostatus.Text Rssiswa!agama = cboagama.Text Rssiswa!alamat_asal = txtasal.Text Rssiswa!alamat_sekarang = txtsekarang.Text Rssiswa!no_telp = txttelp.Text Rssiswa!tgl_daftar = dtpdaftar Rssiswa!pend_terakhir = cbopendidikan.Text Rssiswa!pekerjaan = cbopekerjaan Rssiswa!thn_masuk = txtthn.Text Rssiswa!Status_Siswa = "Aktif" Rssiswa!kodekls = txtkodekls.Text Rssiswa!kodepkt = txtkodepkt.Text End Sub Private Sub AktifTombol() cmdsimpan.Enabled = True cmdedit.Enabled = True cmdhapus.Enabled = True
42
End Sub Private Sub tutuptombol() cmdhapus.Enabled = False cmdedit.Enabled = False cmdsimpan.Enabled = False End Sub Private Sub isiformsiswa() txtnama.Text = Rssiswa!nama txttempat.Text = Rssiswa!t4lahir dtplahir = Rssiswa!tgllahir cbokelamin.Text = Rssiswa!jnskel cbostatus.Text = Rssiswa!Status cboagama.Text = Rssiswa!agama txtasal.Text = Rssiswa!alamat_asal txtsekarang.Text = Rssiswa!alamat_sekarang txttelp.Text = Rssiswa!no_telp cbopendidikan.Text = Rssiswa!pend_terakhir cbopekerjaan = Rssiswa!pekerjaan 'txtthn.Text = Rssiswa!thn_masuk Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
43
txtstatus.Text = Rssiswa!Status_Siswa dtpdaftar = Rssiswa!tgl_daftar txtkodekls.Text = Rssiswa!kodekls txtkodepkt.Text = Rssiswa!kodepkt End Sub Private Sub Validasi() Valid = False If txtnis.Text = Empty Then x = MsgBox("Nomor Induk Siswa harus diisi", 0 + 16, "konfirmasi") txtnis.Text = "" txtnis.SetFocus Exit Sub ElseIf txtnama.Text = Empty Then x = MsgBox("Nama siswa harus diisi", 0 + 16, "konfirmasi") txtnama.Text = "" txtnama.SetFocus Exit Sub ElseIf txttempat.Text = Empty Then x = MsgBox("Tempat Lahir harus diisi", 0 + 16, "konfirmasi") txttempat.Text = "" txttempat.SetFocus Exit Sub ElseIf cbokelamin.Text = Empty Then x = MsgBox("Jenis Kelamin harus diisi", 0 + 16, "konfirmasi") cbokelamin.Text = "" cbokelamin.SetFocus ElseIf cbostatus.Text = Empty Then x = MsgBox("Status harus diisi", 0 + 16, "konfirmasi") cbostatus.Text = "" cbostatus.SetFocus Exit Sub ElseIf cboagama.Text = Empty Then x = MsgBox("Agama harus diisi", 0 + 16, "konfirmasi") cboagama.Text = "" cboagama.SetFocus Exit Sub ElseIf txtasal.Text = Empty Then x = MsgBox("Alamat Asal harus diisi", 0 + 16, "konfirmasi") txtasal.Text = "" txtasal.SetFocus Exit Sub ElseIf txtsekarang.Text = Empty Then x = MsgBox("Alamat sekarang harus diisi", 0 + 16, "konfirmasi") txtsekarang.Text = "" Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
44
txtsekarang.SetFocus Exit Sub ElseIf txttelp.Text = Empty Then x = MsgBox("Harus mengisi nomor Telp atau HP untuk bisa dihubungi jika ada kepentingan", 0 + 16, "konfirmasi") txttelp.Text = "" txttelp.SetFocus Exit Sub ElseIf cbopendidikan.Text = Empty Then x = MsgBox("Pendidikan Terakhir harus diisi", 0 + 16, "konfirmasi") cbopendidikan.Text = "" cbopendidikan.SetFocus Exit Sub ElseIf cbopekerjaan.Text = Empty Then x = MsgBox("Pekerjaan Madyasiswa / i harus diisi", 0 + 16, "konfirmasi") cbopekerjaan.Text = "" cbopekerjaan.SetFocus Exit Sub ElseIf txtkodekls.Text = Empty Then x = MsgBox("Kode kelas harus diisi", 0 + 16, "konfirmasi") txtkodekls.Text = "" txtkodekls.SetFocus Exit Sub ElseIf txtkodepkt.Text = Empty Then x = MsgBox("Kode Paket harus diisi", 0 + 16, "konfirmasi") txtkodepkt.Text = "" txtkodepkt.SetFocus Exit Sub End If Valid = True End Sub Private Sub Tampildata() Set RsTampil = Nothing RsTampil.Open "Select nis,Nama,pend_terakhir,status_siswa from " & _ " tblsiswa where thn_masuk ='" & txtthn & "'", Koneksi Grid1.Refresh Set Grid1.DataSource = RsTampil Grid1.Columns(0).Width = 1750 Grid1.Columns(1).Width = 3000 Grid1.Columns(2).Width = 1500 Grid1.Columns(3).Width = 1000 Grid1.Columns(0).Alignment = dbgCenter Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
45
Grid1.Columns(3).Alignment = dbgCenter Grid1.Columns(0).Caption = "N I S" Grid1.Columns(1).Caption = "NAMA SISWA / i" Grid1.Columns(2).Caption = "PEND.AKHIR" Grid1.Columns(3).Caption = "STATUS" End Sub Private Sub Form_Activate() mdmenuutama.Enabled = False txtjmlsiswa.Text = Rssiswa.RecordCount End Sub Private Sub txtkodekls_Change() ckode = Trim(txtkodekls.Text) If ckode = Empty Then Exit Sub End If If Rskelas.RecordCount > 0 Then Rskelas.MoveFirst End If If Len(ckode) >= 3 Then Rskelas.Find ("Kodekls = '" & ckode & "'") If Rskelas.EOF Then x = MsgBox("Maaf, Kelas dengan Kode <<" & txtkodepkt.Text & ">> tsb belum ada !", 0 + 16, "Konfirmasi") txtkodekls.Text = "" txtkodekls.SetFocus Exit Sub Else txtnamakls.Text = Rskelas!namakls + " / " + Rskelas!Mulaibljr Ada1 = False End If End If End Sub Private Sub txtkodepkt_Change() ckode = Trim(txtkodepkt.Text) If ckode = Empty Then Exit Sub End If If Rspaket.RecordCount > 0 Then Rspaket.MoveFirst End If If Len(ckode) >= 3 Then Rspaket.Find ("Kodepkt = '" & ckode & "'") Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
If Rspaket.EOF Then x = MsgBox("Maaf, Paket dengan Kode <<" & txtkodepkt.Text & ">> tsb belum ada !", 0 + 16, "Konfirmasi") txtkodepkt.Text = "" txtkodepkt.SetFocus Exit Sub Else txtnamapkt.Text = Rspaket!namapkt + " / " + Rspaket!Lamabljr txtkodekls.Enabled = True Ada1 = False End If End If End Sub Private Sub txtnama_KeyPress(keyascii As Integer) keyascii = Asc(UCase(Chr(keyascii))) End Sub Private Sub txtstatus_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txttempat_KeyPress(keyascii As Integer) keyascii = Asc(UCase(Chr(keyascii))) End Sub Private Sub Up1_Change() txtthn.Text = up1 Tampildata blankform1 End Sub Private Sub Form_Load() BukaDatabase blankform1 AturNis tidaksiapisi tutuptombol cmdsimpan.Caption = "&Tambah" cbokelamin.List(0) = "Laki-Laki" cbokelamin.List(1) = "Perempuan" cbostatus.List(0) = "Belum Menikah" cbostatus.List(1) = "Menikah" cboagama.List(0) = "Islam" cboagama.List(1) = "Kristen" cboagama.List(2) = "Protestan" cboagama.List(3) = "Hindu" Bimbingan Visual Basic untuk kalangan terbatas
46
By. Yanto Naim - TI
47
cboagama.List(4) = "Bunda" cboagama.List(5) = "Konghucu" cbopendidikan.List(0) = "SD" cbopendidikan.List(1) = "SMP" cbopendidikan.List(2) = "SMA" cbopendidikan.List(3) = "SMK" cbopendidikan.List(4) = "MA" cbopendidikan.List(5) = "D1" cbopendidikan.List(6) = "D2" cbopendidikan.List(7) = "D3" cbopendidikan.List(8) = "S1" cbopekerjaan.List(0) = "Belum Ada" cbopekerjaan.List(1) = "Mahasiswa" cbopekerjaan.List(2) = "wiraswasta" up1.Value = Year(Date) dtplahir = Date dtpdaftar = Date txtthn.Text = up1 Tampildata End Sub Private Sub Form_Unload(Cancel As Integer) Koneksi.Close End Sub Private Sub txtkodepkt_keydown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyF1 Then txtkodepkt.Text = "" Sql = "Select Namapkt,Kodepkt,lamabljr from tblpaket where kodepkt like '" & txtkodepkt & "%' order by Kodepkt" Ada = True frminfo.Caption = " >>> Info Data Paket Tahun " & txtthn & "<<<" frminfo.Show vbModal, Me Ada = False txtkodepkt.Text = frminfo.Kode txtkodepkt_Lostfocus End If If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txtkodepkt_Lostfocus() ckode = Trim(txtkodepkt.Text) If ckode = Empty Then Exit Sub Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
48
End If If Rspaket.RecordCount > 0 Then Rspaket.MoveFirst End If If Len(ckode) >= 3 Then Rspaket.Find ("Kodepkt = '" & ckode & "'") If Rspaket.EOF Then x = MsgBox("Maaf, Paket dengan Kode <<" & txtkodepkt.Text & ">> tsb belum ada !", 0 + 16, "Konfirmasi") txtkodepkt.Text = "" txtkodepkt.SetFocus Exit Sub Else txtnamapkt.Text = Rspaket!namapkt + " / " + Rspaket!Lamabljr txtkodekls.Enabled = True txtkodekls.SetFocus Ada1 = False End If End If End Sub Private Sub txtkodekls_keydown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyF1 Then txtkodekls.Text = "" Sql = "Select Namakls,Kodekls,mulaibljr from tblkelas where kodekls like '" & txtkodekls & "%' order by Kodekls" Ada = True frminfo.Caption = " >>> Info Data Kelas Tahun " & txtthn & "<<<" frminfo.Show vbModal, Me Ada = False txtkodekls.Text = frminfo.Kode txtkodekls_Lostfocus End If If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txtkodekls_Lostfocus() ckode = Trim(txtkodekls.Text) If ckode = Empty Then Exit Sub End If If Rskelas.RecordCount > 0 Then Rskelas.MoveFirst End If Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
49
If Len(ckode) >= 3 Then Rskelas.Find ("Kodekls = '" & ckode & "'") If Rskelas.EOF Then x = MsgBox("Maaf, Kelas dengan Kode <<" & txtkodepkt.Text & ">> tsb belum ada !", 0 + 16, "Konfirmasi") txtkodekls.Text = "" txtkodekls.SetFocus Exit Sub Else txtnamakls.Text = Rskelas!namakls + " / " + Rskelas!Mulaibljr Ada1 = False End If End If End Sub Public Sub Batal() txtnis.Enabled = True txtnis.BackColor = &H80000005 txtnama.Text = "" txttempat.Text = "" cbokelamin.Text = "" cbostatus.Text = "" cboagama.Text = "" txtasal.Text = "" txtsekarang.Text = "" txttelp.Text = "" cbopendidikan.Text = "" cboagama.Text = "" txtstatus.Text = "" cbopekerjaan.Text = "" txtkodekls.Text = "" txtkodepkt.Text = "" txtnamakls.Text = "" txtnamapkt.Text = "" txtnama.Enabled = False dtpdaftar.Enabled = False txttempat.Enabled = False cbokelamin.Enabled = False cbostatus.Enabled = False cboagama.Enabled = False txtasal.Enabled = False txtsekarang.Enabled = False txttelp.Enabled = False cbopendidikan.Enabled = False cboagama.Enabled = False Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
50
cbopekerjaan.Enabled = False txtstatus.Enabled = False txtkodekls.Enabled = False txtkodepkt.Enabled = False cmdsimpan.Enabled = False End Sub Private Sub CmdSimpan_Click() If cmdsimpan.Caption = "&Tambah" Then Batal AturNis txtnis.SetFocus Exit Sub End If Validasi If Valid = True Then If Ada1 = False Then Rssiswa.AddNew isitabelsiswa Rssiswa.Update Else isitabelsiswa Rssiswa.Update End If cmdsimpan.Caption = "&Tambah" Else cmdsimpan.Caption = "&Simpan" End If Rssiswa.Requery Tampildata AturNis txtjmlsiswa.Text = RsTampil.RecordCount End Sub Private Sub CmdBatal_Click() blankform1 AturNis tidaksiapisi txtnis.Enabled = True txtnis.BackColor = &H80000005 txtnis.SetFocus cmdsimpan.Caption = "&Tambah" tutuptombol End Sub Private Sub cmdedit_click() Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
51
tutuptombol cmdsimpan.Enabled = True Ada1 = True SiapIsi1 txtnis.Enabled = False txtnis.BackColor = &H80000016 cmdsimpan.Caption = "&Simpan" txtnama.SetFocus End Sub Private Sub CmdHapus_Click() ckode = Trim(txtnis.Text) Rspembayaran.Find ("nis='" & ckode & "'"), , adSearchForward, 1 If Not Rspembayaran.EOF Then x = MsgBox("Data Siswa yang bernama " & txtnama_siswa & " tidak dapat dihapus", 0 + 16, "konfirmasi") blankform1 txtnis.Enabled = True txtnis.SetFocus Exit Sub Else Y = MsgBox("Benar anda ingin hapus data dengan nama " & txtnama & " ???", vbYesNo + vbQuestion + vbDefaultButton2, "konfirmasi") Select Case Y Case vbYes Koneksi.Execute "delete * from tblsiswa where nis ='" & ckode & "'" AturNis Tampildata Case vbNo AturNis cmdkeluar.SetFocus End Select End If CmdBatal_Click Rssiswa.Requery Tampildata End Sub Private Sub CmdKeluar_Click() Unload Me mdmenuutama.Enabled = True End Sub Private Sub Grid1_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then If Rssiswa.RecordCount > 0 Then Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
52
txtnis.Text = Grid1.Columns(0) txtnis_Lostfocus End If End If End Sub Private Sub txtnama_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub dtpdaftar_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub Txttempat_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub dtplahir_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub cbokelamin_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub cbostatus_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub cboagama_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub Txtasal_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
53
Private Sub Txtsekarang_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub Txttelp_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub cbopendidikan_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub cbopekerjaan_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub Txtnis_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyF1 Then txtnis.Text = "" Sql = "Select Alamat_Asal,nis,nama from tblsiswa Where thn_masuk='" & txtthn & "'and status_siswa='Aktif' order by nis" Ada = True frminfo.Caption = " >>> Info Data Siswa Tahun " & txtthn & " <<<" frminfo.Show vbModal, Me Ada = False txtnis.Text = frminfo.Kode txtnis_Lostfocus End If If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txtnis_Lostfocus() ckode = Trim(txtnis.Text) If ckode = Empty Then Exit Sub End If If Rssiswa.RecordCount > 0 Then Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
54
Rssiswa.MoveFirst End If If Len(Trim(txtnis.Text)) <> 8 Then x = MsgBox("Penginputan nis harus 8 karakter!Anda akan dibantu dengan pengaturan nis otomatis", 0 + 64, "Konfirmasi") AturNis txtnis.SetFocus Exit Sub End If Set Rssiswa = Nothing Rssiswa.Open "[tblsiswa] where nis ='" & txtnis & "' and thn_masuk='" & txtthn & "'and nis='" & txtnis & "'", Koneksi, adOpenDynamic, adLockOptimistic If Rssiswa.EOF Then SiapIsi1 blankform1 txtnama.SetFocus txtstatus.Text = "Aktif" txtstatus.Enabled = False cmdsimpan.Enabled = True cmdsimpan.Caption = "&Simpan" Ada1 = False Else isiformsiswa tidaksiapisi cmdedit.Enabled = True cmdhapus.Enabled = True cmdsimpan.Enabled = True cmdsimpan.Caption = "&Tambah" cmdbatal.SetFocus Ada1 = True End If End Sub Private Sub AturNis() Set RsTampil = Nothing RsTampil.Open "Select * From tblsiswa Where Thn_Masuk='" & txtthn & "' order by nis", Koneksi cnis = "001" + Trim(Right(txtthn.Text, 2)) If RsTampil.RecordCount = 0 Then cno = "001" Else
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
55
Else RsTampil.MoveLast Na = Val(Right(RsTampil!nis, 3)) + 1 If Len(Na) = 1 Then cno = "00" + Trim(Str(Na)) ElseIf Len(Na) = 2 Then cno = "0" + Trim(Str(Na)) ElseIf Len(Na) = 3 Then cno = Trim(Str(Na)) End If End If txtnis.Text = cnis + cno End Sub Private Sub up1_DownClick() AturNis End Sub Design Form seperti gambar dibawah ini, dan berikan nama FrmSertifikat Form Nomor Sertifikat Alumni
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
56
Ketik Listing dibawah ini ! Public Ada, Ada1, Valid As Boolean Public Sql, cno, cnama As String Dim RsTampil As New ADODB.Recordset Private Sub Grid1_Click() txtno.SetFocus End Sub Private Sub Grid1_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab txtno.SetFocus End If End Sub Private Sub txttglujian_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab cmdproses.Enabled = True cmdproses.SetFocus End If End Sub Private Sub txtkode_Click() txtkode.Text = "" txtnama.Text = "" Tampildata End Sub Private Sub txtno_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab txttglujian.Enabled = True txttglujian.SetFocus End If End Sub Private Sub CmdLagi_Click() cmdproses.Enabled = False txtkode.Text = "" txtnama.Text = "" txtno.Text = "" txttglujian.Text = "" txtjml_siswa.Text = "" txtno.Enabled = False txttglujian.Enabled = False Tampildata txtkode.SetFocus Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
57
End Sub Private Sub cmdproses_Click() cno = Grid1.Columns(0) cnama = txtno.Text Y = MsgBox("Ingin simpan data tersebut ???", vbYesNo + vbQuestion + vbDefaultButton2, "Konfirmasi Kembali") Select Case Y Case vbYes Koneksi.Execute "update tblalumni set nosertifikat ='" & cnama & "',tglujian='" & txttglujian & "' where nis='" & cno & "'" Tampildata txtjml_siswa.Text = RsTampil.RecordCount Grid1.Enabled = True Grid1.SetFocus Case vbNo cmdproses.Enabled = False cmdkeluar.SetFocus txtjml_siswa.Text = RsTampil.RecordCount End Select End Sub Private Sub Up1_Change() txtthn.Text = Up1 End Sub Private Sub CmdKeluar_Click() Unload Me mdmenuutama.Enabled = True End Sub Private Sub Form_Activate() Grid1.Enabled = False txtno.Enabled = False txttglujian.Enabled = False cmdproses.Enabled = False mdmenuutama.Enabled = False End Sub Private Sub Form_Load() BukaDatabase Up1.Value = Year(Date) txtthn.Text = Up1 End Sub Private Sub Form_Unload(Cancel As Integer) Koneksi.Close Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
58
End Sub Private Sub txtkode_keydown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyF1 Then txtkode.Text = "" Sql = "Select Namapkt,Kodepkt,Lamabljr from tblpaket where kodepkt like '" & txtkode & "%' order by Kodepkt" Ada = True frminfo.Caption = " >>> Info Data Paket Tahun " & txtthn & "<<<" frminfo.Grid1.Columns(0).Caption = "NAMA PAKET" frminfo.Grid1.Columns(1).Caption = "KODE PAKET" frminfo.Grid1.Columns(2).Caption = "LAMA BELAJAR" frminfo.Show vbModal, Me Ada = False txtkode.Text = frminfo.Kode txtkode_Lostfocus End If If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txtkode_Lostfocus() ckode = Trim(txtkode.Text) If ckode = Empty Then Exit Sub End If If Rspaket.RecordCount > 0 Then Rspaket.MoveFirst End If If Len(ckode) >= 3 Then Rspaket.Find ("Kodepkt = '" & ckode & "'") If Rspaket.EOF Then x = MsgBox("Maaf, Paket dengan Kode <<" & txtkode.Text & ">> tsb belum ada !", 0 + 16, "Konfirmasi") txtkode.Text = "" txtkode.SetFocus Exit Sub Else txtnama.Text = Rspaket!namapkt + " / " + "Lama Belajar " + Rspaket!Lamabljr Ada1 = False cmdproses.Enabled = False Tampildata txtno.Enabled = True txttglujian.Enabled = True Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
59
Grid1.Enabled = True Grid1.SetFocus txtjml_siswa.Text = RsTampil.RecordCount If RsTampil.RecordCount = 0 Then x = MsgBox("Maaf. Data madyasiswa yang SELESAI untuk paket " & txtnama & " di tahun " & txtthn & " ... belum ada !!!", 0 + 64, "Pemberitahuan") txtkode.Text = "" txtnama.Text = "" txtkode.SetFocus Exit Sub End If End If End If End Sub Private Sub Tampildata() Set RsTampil = Nothing RsTampil.Open "Select tblalumni.nis,tblsiswa.nama,tblalumni.nosertifikat from " & _ " tblalumni,tblsiswa where tblalumni.kodepkt ='" & txtkode & "' and tblalumni.nis=tblsiswa.nis and right(tblalumni.tglselesai,4) ='" & txtthn & "' Order by tblalumni.nis", Koneksi Grid1.Refresh Set Grid1.DataSource = RsTampil Grid1.Columns(0).Width = 1000 Grid1.Columns(1).Width = 3250 Grid1.Columns(2).Width = 2750 Grid1.Columns(0).Alignment = dbgCenter Grid1.Columns(2).Alignment = dbgCenter Grid1.Columns(0).Caption = "N I S" Grid1.Columns(1).Caption = "NAMA SISWA" Grid1.Columns(2).Caption = "NO.SERTIFIKAT" End Sub
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
60
Design Form seperti gambar dibawah ini, dan berikan nama FrmPeriksa Form Pemeriksaan Pembayaran
Ketik Listing dibawah ini ! Public Ada, Ada1, Valid As Boolean Public Sql, cno, cnama As String Dim RsTampil As New ADODB.Recordset Private Sub cmdcetak_Click() coleh = frmreading.TxtNamap crpcetak2.ReportFileName = App.Path & "\" & "rptlaporan_bukti.rpt" crpcetak2.SelectionFormula = " {tblpembayaran.ta} ='" & txtthn & "' and {tblpembayaran.kodepkt} ='" & txtkode & "' and {tblpembayaran.nis} ='" & txtnis & "'" crpcetak2.Formulas(0) = "voleh ='" & coleh & "'" crpcetak2.RetrieveDataFiles Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
61
crpcetak2.WindowState = crptMaximized crpcetak2.Action = 1 End Sub Private Sub cmdcetak1_Click() coleh = frmreading.TxtNamap crpcetak2.ReportFileName = App.Path & "\" & "rptlaporan_bukti.rpt" crpcetak2.SelectionFormula = " {tblpembayaran.ta} ='" & txtthn & "' and {tblpembayaran.kodepkt} ='" & txtkode & "' and {tblpembayaran.nis} ='" & txtnis & "'" crpcetak2.Formulas(0) = "voleh ='" & coleh & "'" crpcetak2.RetrieveDataFiles crpcetak2.WindowState = crptMaximized crpcetak2.CopiesToPrinter = 1 crpcetak2.Destination = crptToPrinter crpcetak2.Action = 1 End Sub Private Sub CmdLagi_Click() txtkode.Text = "" txtnis.Text = "" txtnama_1.Text = "" txtnama.Text = "" txtjml.Text = "" Tampildata cmdcetak.Enabled = False cmdcetak1.Enabled = False txtkode.SetFocus End Sub Private Sub txtnama_1_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyF1 Then Sql = "Select nama,nis from tblsiswa Where Kodepkt ='" & txtkode & "' and Nama like '" & txtnama_1 & "%'and status_siswa='Aktif' and thn_masuk='" & txtthn & "' order by nis" Ada = True frminfo.Caption = " >>> Info Data Siswa Tahun " & txtthn & " <<<" frminfo.Show vbModal, Me Ada = False txtnis.Text = frminfo.Kode txtnis.Enabled = True txtnis_Lostfocus End If If KeyCode = vbKeyReturn Then SendKeys vbTab Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
62
cmdcetak.Enabled = True cmdcetak1.Enabled = True cmdcetak.SetFocus End If End Sub Private Sub txtnama_1_KeyPress(keyascii As Integer) keyascii = Asc(UCase(Chr(keyascii))) End Sub Private Sub Up1_Change() txtthn.Text = Up1 End Sub Private Sub CmdKeluar_Click() Unload Me mdmenuutama.Enabled = True End Sub Private Sub Form_Activate() Grid1.Enabled = False mdmenuutama.Enabled = False cmdcetak.Enabled = False cmdcetak1.Enabled = False End Sub Private Sub Form_Load() BukaDatabase txtthn.Text = Year(Date) End Sub Private Sub Form_Unload(Cancel As Integer) Koneksi.Close End Sub Private Sub txtkode_keydown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyF1 Then txtkode.Text = "" Sql = "Select Namapkt,Kodepkt,Lamabljr from tblpaket where kodepkt like '" & txtkode & "%' order by Kodepkt" Ada = True frminfo.Caption = " >>> Info Data Paket Tahun " & txtthn & "<<<" frminfo.Grid1.Columns(0).Caption = "NAMA PAKET" frminfo.Grid1.Columns(1).Caption = "KODE PAKET" frminfo.Grid1.Columns(2).Caption = "LAMA BELAJAR" Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
63
frminfo.Show vbModal, Me Ada = False txtkode.Text = frminfo.Kode txtkode_Lostfocus End If If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txtkode_Lostfocus() ckode = Trim(txtkode.Text) If ckode = Empty Then Exit Sub End If If Rspaket.RecordCount > 0 Then Rspaket.MoveFirst End If If Len(ckode) >= 3 Then Rspaket.Find ("Kodepkt = '" & ckode & "'") If Rspaket.EOF Then x = MsgBox("Maaf, Paket dengan Kode <<" & txtkode.Text & ">> tsb belum ada !", 0 + 16, "Konfirmasi") txtkode.Text = "" txtkode.SetFocus Exit Sub Else txtnama.Text = Rspaket!namapkt + " / " + "Lama Belajar " + Rspaket!Lamabljr txtnis.Enabled = True txtnama_1.Enabled = True Ada1 = False 'Tampildata End If End If End Sub Private Sub Tampildata() Set RsTampil = Nothing RsTampil.Open "Select tblpembayaran.nobukti,tblbiaya.jnsby,tblpembayaran.tglbyr,tblpembayaran.angsuran from " & _ " tblpembayaran,tblbiaya where tblpembayaran.Kodepkt ='" & txtkode & "' and tblpembayaran.kodeby=tblbiaya.kodeby and tblpembayaran.ta ='" & txtthn & "' and tblpembayaran.nis='" & txtnis & "' Order by tblpembayaran.nobukti", Koneksi Grid1.Refresh Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
64
Set Grid1.DataSource = RsTampil Grid1.Columns(0).Width = 1000 Grid1.Columns(1).Width = 3250 Grid1.Columns(2).Width = 1000 Grid1.Columns(3).Width = 1000 Grid1.Columns(0).Alignment = dbgCenter Grid1.Columns(2).Alignment = dbgCenter Grid1.Columns(3).Alignment = dbgCenter Grid1.Columns(0).Caption = "NO.BUKTI" Grid1.Columns(1).Caption = "JENIS BIAYA YANG DIBAYAR" Grid1.Columns(2).Caption = "TGL.BAYAR" Grid1.Columns(3).Caption = "ANGSURAN" End Sub Private Sub Txtnis_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyF1 Then txtnis.Text = "" Sql = "Select Alamat_Asal,nis,nama from tblsiswa Where kodepkt='" & txtkode & "' and thn_masuk='" & txtthn & "'and status_siswa='Aktif' order by nis" Ada = True frminfo.Caption = " >>> Info Data Siswa Tahun " & txtthn & " <<<" frminfo.Show vbModal, Me Ada = False txtnis.Text = frminfo.Kode txtnis_Lostfocus End If If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txtnis_Lostfocus() ckode = Trim(txtnis.Text) If ckode = Empty Then Exit Sub End If If Rssiswa.RecordCount > 0 Then Rssiswa.MoveFirst End If Set Rssiswa = Nothing Rssiswa.Open "[tblsiswa] where Kodepkt = '" & txtkode & "'" & _ "and nis = '" & txtnis & " ' And " & _ "Kodepkt='" & txtkode & "'and thn_masuk='" & txtthn & "'and status_siswa='Aktif'", Koneksi, adOpenDynamic, adLockOptimistic Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
65
If Rssiswa.EOF Then x = MsgBox("Sorry, Siswa dengan No. Induk " & txtnis & " tersebut belum terdaftar", 0 + 64, "Konfirmasi") txtnis.Text = "" txtnis.Enabled = True txtnis.SetFocus Ada1 = False Else txtnama_1.Text = Rssiswa!nama Tampildata txtjml.Text = RsTampil.RecordCount If RsTampil.RecordCount = 0 Then x = MsgBox("Maaf. Siswa yang bernama yang bernama " & txtnama_1 & " di tahun " & txtthn & " ... belum pernah melakukan transaksi pembayaran !!!", 0 + 64, "Pemberitahuan") txtnis.Text = "" txtnama_1.Text = "" txtnis.SetFocus Exit Sub Else cmdcetak.Enabled = True cmdcetak1.Enabled = True End If Ada1 = True End If End Sub
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
66
Design Form seperti gambar dibawah ini, dan berikan nama Frmpembayaran Form Pembayaran
Ketik Listing dibawah ini ! Public Ada, Ada1, Valid As Boolean Public Sql, cno, cnama As String Dim RsTampil As New ADODB.Recordset Private Sub CmdBatal_Click() blankform1 tidaksiapisi txtkodepkt.Enabled = True txtkodepkt.SetFocus End Sub Private Sub blankform1() txtkode_biaya.Text = "" txtnama_biaya.Text = "" txtkodepkt.Text = "" txtnamapkt.Text = "" txtnis.Text = "" txtnama_siswa.Text = "" cboangsuran.Text = "" txtjumlah_biaya.Text = "" txtjumlah_bayar.Text = "" txtstatus.Text = "" End Sub Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
67
Private Sub CmdKeluar_Click() Unload Me mdmenuutama.Enabled = True End Sub Private Sub Form_Activate() mdmenuutama.Enabled = False cmdsimpan.Caption = "&Tambah" End Sub Private Sub Form_Load() BukaDatabase txtthn.Text = Year(Date) dtpbayar = Date tidaksiapisi End Sub Private Sub Form_Unload(Cancel As Integer) Koneksi.Close End Sub Private Sub txtjumlah_bayar_LostFocus() If Val(txtjumlah_bayar.Text) <> Val(txtjumlah_biaya.Text) Then x = MsgBox("Penginputan pembayaran anda harus sesuai dengan jumlah bayar !", 0 + 64, "Konfirmasi") txtjumlah_bayar.Text = "" txtjumlah_bayar.SetFocus Exit Sub Else cmdsimpan.Caption = "&Simpan" cmdsimpan.Enabled = True txtstatus.Text = "Lunas" cmdsimpan.SetFocus End If Set Rspembayaran = Nothing Rspembayaran.Open "[tblpembayaran] where Kodepkt = '" & txtkodepkt & "' and kodeby='" & txtkode_biaya & "' and nis='" & txtnis & "' and angsuran='" & cboangsuran & "'", Koneksi, adOpenDynamic, adLockOptimistic If Not Rspembayaran.EOF Then x = MsgBox("Pembayaran " & txtnama_biaya & " Sudah dibayar sebelumnya !", 0 + 64, "Konfirmasi") cmdsimpan.SetFocus cmdsimpan.Caption = "&Tambah" Ada1 = False Exit Sub End If End Sub Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
68
Private Sub Up1_Change() txtthn.Text = Up1 End Sub Private Sub Txtnama_siswa_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyF1 Then Sql = "Select nama,nis from tblsiswa Where Kodepkt ='" & txtkodepkt & "' and Nama like '" & txtnama_siswa & "%'and status_siswa='Aktif' and thn_masuk='" & txtthn & "' order by nis" Ada = True frminfo.Caption = " >>> Info Data Siswa Tahun " & txtthn & " <<<" frminfo.Show vbModal, Me Ada = False txtnis.Text = frminfo.Kode 'txtnama_1.Text = frminfo.Teks txtnis.Enabled = True txtnis_Lostfocus End If If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txtnis_Lostfocus() ckode = Trim(txtnis.Text) If ckode = Empty Then Exit Sub End If If Rssiswa.RecordCount > 0 Then Rssiswa.MoveFirst End If Set Rssiswa = Nothing Rssiswa.Open "[tblsiswa] where Kodepkt = '" & txtkodepkt & "'" & _ "and nis = '" & txtnis & " ' And " & _ "Kodepkt='" & txtkodepkt & "'and thn_masuk='" & txtthn & "'and status_siswa='Aktif'", Koneksi, adOpenDynamic, adLockOptimistic If Rssiswa.EOF Then x = MsgBox("Sorry, Siswa dengan No. Induk " & txtnis & " tersebut belum terdaftar", 0 + 64, "Konfirmasi") txtnama_siswa.Text = "" txtnama_siswa.Enabled = True txtnama_siswa.SetFocus Ada1 = False Else Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
69
txtnama_siswa.Text = Rssiswa!nama Ada1 = True End If Aturnobuk End Sub Private Sub txtkodepkt_keydown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyF1 Then txtkodepkt.Text = "" Sql = "Select Namapkt,Kodepkt,Lamabljr from tblpaket where kodepkt like '" & txtkodepkt & "%' order by Kodepkt" Ada = True frminfo.Caption = " >>> Info Data Paket Tahun " & txtthn & "<<<" frminfo.Grid1.Columns(0).Caption = "NAMA PAKET" frminfo.Grid1.Columns(1).Caption = "KODE PAKET" frminfo.Grid1.Columns(2).Caption = "LAMA BELAJAR" frminfo.Show vbModal, Me Ada = False txtkodepkt.Text = frminfo.Kode txtkodepkt_Lostfocus End If If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txtkodepkt_Lostfocus() ckode = Trim(txtkodepkt.Text) If ckode = Empty Then Exit Sub End If If Rspaket.RecordCount > 0 Then Rspaket.MoveFirst End If If Len(ckode) >= 3 Then Rspaket.Find ("Kodepkt = '" & ckode & "'") If Rspaket.EOF Then x = MsgBox("Maaf, Paket dengan Kode <<" & txtkodepkt.Text & ">> tsb belum ada !", 0 + 16, "Konfirmasi") txtkodepkt.Text = "" txtkodepkt.SetFocus Exit Sub Else txtnamapkt.Text = Rspaket!namapkt txtnis.Enabled = False txtnama_siswa.Enabled = True Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
70
txtnama_siswa.SetFocus Ada1 = False End If End If If Left(txtkodepkt, 1) = "1" Then cboangsuran.List(0) = "1" ElseIf Left(txtkodepkt, 1) = "2" Then cboangsuran.List(0) = "1" cboangsuran.List(1) = "2" ElseIf Left(txtkodepkt, 1) = "3" Then cboangsuran.List(0) = "1" cboangsuran.List(1) = "2" cboangsuran.List(2) = "3" ElseIf Left(txtkodepkt, 1) = "4" Then cboangsuran.List(0) = "1" cboangsuran.List(1) = "2" cboangsuran.List(2) = "3" cboangsuran.List(3) = "4" ElseIf Left(txtkodepkt, 1) = "5" Then cboangsuran.List(0) = "1" cboangsuran.List(1) = "2" cboangsuran.List(2) = "3" cboangsuran.List(3) = "4" cboangsuran.List(3) = "5" ElseIf Left(txtkodepkt, 1) = "6" Then cboangsuran.List(0) = "1" cboangsuran.List(1) = "2" cboangsuran.List(2) = "3" cboangsuran.List(3) = "4" cboangsuran.List(3) = "5" cboangsuran.List(3) = "6" End If End Sub Private Sub Txtnis_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub cboangsuran_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
71
Private Sub txtjumlah_bayar_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub cbosemester_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub dtpbayar_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txtjumlah_bayar_keypress(keyascii As Integer) If Not (keyascii >= Asc("0") And keyascii <= Asc("9") Or _ keyascii = vbKeyBack) Then keyascii = 0 End If End Sub Private Sub tidaksiapisi() txtnamapkt.Enabled = False txtnis.Enabled = False txtnama_siswa.Enabled = False cboangsuran.Enabled = False txtnama_biaya.Enabled = False txtjumlah_bayar.Enabled = False cmdsimpan.Enabled = False End Sub Private Sub SiapIsi() txtkodepkt.Enabled = True txtnis.Enabled = True cboangsuran.Enabled = True txtjumlah_bayar.Enabled = True End Sub Private Sub CmdSimpan_Click() If cmdsimpan.Caption = "&Tambah" Then Aturnobuk txtnis.SetFocus cboangsuran.Text = "" txtkode_biaya.Text = "" txtnama_biaya.Text = "" txtjumlah_biaya.Text = "" Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
72
txtjumlah_bayar.Text = "" txtstatus.Text = "" Exit Sub End If Set Rspembayaran = Nothing Rspembayaran.Open "[tblpembayaran] where Kodepkt = '" & txtkodepkt & "' and kodeby='" & txtkode_biaya & "' and nis='" & txtnis & "' and angsuran='" & cboangsuran & "'", Koneksi, adOpenDynamic, adLockOptimistic If Not Rspembayaran.EOF Then x = MsgBox("Pembayaran " & txtnama_biaya & " Sudah dibayar sebelumnya !", 0 + 64, "Konfirmasi") cmdsimpan.SetFocus cmdsimpan.Caption = "&Tambah" Ada1 = False Exit Sub End If Validasi If Valid = True Then If Ada1 = True Then Set Rspembayaran = Nothing Rspembayaran.Open "Select * from tblPembayaran where KodeBy ='" & txtkode_biaya & "'" & _ "and ta ='" & txtthn & "' and nis ='" & txtnis & "'" & _ "and angsuran = '" & cboangsuran & "'", Koneksi, adOpenDynamic, adLockOptimistic If Rspembayaran.RecordCount = 0 Then Rspembayaran.AddNew Rspembayaran!kodepkt = txtkodepkt.Text Rspembayaran!nis = txtnis.Text Rspembayaran!tglbyr = dtpbayar Rspembayaran!ta = txtthn.Text Rspembayaran!angsuran = cboangsuran.Text Rspembayaran!kodeby = txtkode_biaya.Text Rspembayaran!jmlbyr = txtjumlah_bayar.Text Rspembayaran!stsbyr = "Lunas" Rspembayaran!nobukti = txtno_bukti.Text Rspembayaran.Update Else Rspembayaran.AddNew Rspembayaran!kodepkt = txtkodepkt.Text Rspembayaran!nis = txtnis.Text Rspembayaran!tglbyr = dtpbayar Rspembayaran!ta = txtthn.Text Rspembayaran!angsuran = cboangsuran.Text Rspembayaran!kodeby = txtkode_biaya.Text Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
73
Rspembayaran!jmlbyr = txtjumlah_bayar.Text Rspembayaran!stsbyr = "Lunas" Rspembayaran!nobukti = txtno_bukti.Text Rspembayaran.Update End If Aturnobuk End If cmdsimpan.Caption = "&Tambah" Else cmdsimpan.Caption = "&Simpan" End If Rspembayaran.Requery Aturnobuk
End Sub Private Sub Aturnobuk() Set Rspembayaran = Nothing Rspembayaran.Open "Select * From tblpembayaran Where Kodepkt ='" & txtkodepkt & "'" & _ " and year(tblpembayaran.tglbyr) =" & Year(dtpbayar) & " order by nobukti", Koneksi k1 = txtkodepkt.Text + "-" + Trim(Right(Year(dtpbayar), 2)) + "-" If Rspembayaran.RecordCount = 0 Then cno = "0001" Else Rspembayaran.MoveLast Na = Val(Right(Rspembayaran!nobukti, 4)) + 1 If Len(Na) = 1 Then cno = "000" + Trim(Str(Na)) ElseIf Len(Na) = 2 Then cno = "00" + Trim(Str(Na)) ElseIf Len(Na) = 3 Then cno = "0" + Trim(Str(Na)) ElseIf Len(Na) = 4 Then cno = Trim(Str(Na)) End If End If txtno_bukti.Text = k1 + cno End Sub Private Sub Validasi() Valid = False
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
74 If cboangsuran.Text = Empty Then x = MsgBox("Angsuran harus diisi", 0 + 16, "konfirmasi") cboangsuran.Text = "" cboangsuran.SetFocus Exit Sub ElseIf txtkode_biaya.Text = Empty Then x = MsgBox("Jenis Biaya harus diisi", 0 + 16, "konfirmasi") txtkode_biaya.Text = "" txtkode_biaya.SetFocus Exit Sub ElseIf txtkodepkt.Text = Empty Then x = MsgBox("Jurusan harus diisi", 0 + 16, "konfirmasi") txtkodepkt.Text = "" txtkodepkt.SetFocus Exit Sub ElseIf txtnis.Text = Empty Then x = MsgBox("Data siswa harus diisi", 0 + 16, "konfirmasi") txtnis.Text = "" txtnama_siswa.SetFocus Exit Sub ElseIf txtjumlah_bayar.Text = Empty Then x = MsgBox("Jumlah bayar harus diisi", 0 + 16, "konfirmasi") txtjumlah_bayar.Text = "" txtjumlah_bayar.SetFocus Exit Sub End If Valid = True End Sub Private Sub Txtkode_biaya_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyF1 Then txtkode_biaya.Text = "" Sql = "Select Jnsby,Kodeby from tblbiaya Where Kodepkt ='" & txtkodepkt & "'and Ta='" & txtthn & "' order by Kodeby" Ada = True frminfo.Caption = " >>> Info Data Biaya Pelatihan Tahun " & txtthn & "<<<" frminfo.Show vbModal, Me Ada = False txtkode_biaya.Text = frminfo.Kode txtkode_biaya_Lostfocus End If If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txtkode_biaya_Lostfocus() ckode = Trim(txtkode_biaya.Text) If ckode = Empty Then Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
75 Exit Sub End If If Rsbiaya.RecordCount > 0 Then Rsbiaya.MoveFirst End If Set Rsbiaya = Nothing Rsbiaya.Open "[tblbiaya] where Kodepkt = '" & txtkodepkt & "'" & _ "and Kodeby = '" & txtkode_biaya & " ' And " & _ "Kodepkt = '" & txtkodepkt & "' and Ta='" & txtthn & "'", Koneksi, adOpenDynamic, adLockOptimistic If Rsbiaya.RecordCount = 0 Then x = MsgBox("Sorry. Jenis Biaya tersebut belum diinput untuk Tahun. " & txtthn & " !", 0 + 64, "Konfirmasi") txtkode_biaya.Text = "" txtkode_biaya.SetFocus Ada1 = False Else txtnama_biaya.Text = Rsbiaya!jnsby txtjumlah_biaya.Text = Rsbiaya!jmlby Ada1 = True End If If Mid(txtkode_biaya.Text, 4, 1) = "D" Then cboangsuran.Enabled = False cboangsuran.Text = "-" txtjumlah_bayar.Enabled = True txtjumlah_bayar.SetFocus Else cboangsuran.Enabled = True txtjumlah_bayar.Enabled = True cboangsuran.SetFocus End If If Mid(txtkode_biaya.Text, 4, 1) = "U" Then cboangsuran.Enabled = False cboangsuran.Text = "-" txtjumlah_bayar.Enabled = True txtjumlah_bayar.SetFocus Else cboangsuran.Enabled = True cboangsuran.SetFocus txtjumlah_bayar.Enabled = True End If End Sub
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
76
Design Form seperti gambar dibawah ini, dan berikan nama Frmubahstatus Form Ubah Status Siswa
Ketik Listing dibawah ini ! Public Ada, Ada1, Valid As Boolean Public Sql, cno As String Dim RsTampil As New ADODB.Recordset Private Sub cbostatus_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab cmdproses.Enabled = True cmdproses.SetFocus End If End Sub Private Sub CmdLagi_Click() cmdproses.Enabled = False txtkode.Text = "" txtnama.Text = "" Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
77
cbostatus.Text = "" txtjml_siswa.Text = "" cbostatus.Enabled = False Tampildata txtkode.SetFocus End Sub Private Sub cmdproses_Click() cno = Grid1.Columns(0) Y = MsgBox("Yakin dengan data yang anda ingin ubah???", vbYesNo + vbQuestion + vbDefaultButton2, "Konfirmasi Kembali") Select Case Y Case vbYes If Ada1 = False Then If cbostatus = "Selesai" Then Rsalumni.AddNew Rsalumni!kodepkt = txtkode.Text Rsalumni!nis = cno Rsalumni!tglselesai = Date Rsalumni.Update Rsstatus.AddNew Rsstatus!kodepkt = txtkode.Text Rsstatus!nis = cno Rsstatus!Status = cbostatus.Text Rsstatus!tgl_ubah = Date Rsstatus.Update Else Rsstatus.AddNew Rsstatus!kodepkt = txtkode.Text Rsstatus!nis = cno Rsstatus!Status = cbostatus.Text Rsstatus!tgl_ubah = Date Rsstatus.Update End If End If Koneksi.Execute "update tblsiswa set status_siswa='" & cbostatus & "' where nis='" & cno & "'and kodepkt='" & txtkode & "' and thn_masuk='" & txtthn & "'" Tampildata txtjml_siswa.Text = RsTampil.RecordCount If RsTampil.RecordCount > 0 Then cmdproses.Enabled = True cmdproses.SetFocus Else cmdproses.Enabled = False Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
78
cmdkeluar.SetFocus End If Case vbNo cmdproses.Enabled = False cbostatus.Text = "" txtjml_siswa.Text = "" cmdkeluar.SetFocus txtjml_siswa.Text = RsTampil.RecordCount End Select End Sub Private Sub Grid1_KeyDown(KeyCode As Integer, Shift As Integer) cbostatus.Enabled = True cbostatus.SetFocus End Sub Private Sub Up1_Change() txtthn.Text = Up1 End Sub Private Sub CmdKeluar_Click() Unload Me mdmenuutama.Enabled = True End Sub Private Sub Form_Activate() Grid1.Enabled = False cbostatus.Enabled = False cmdproses.Enabled = False mdmenuutama.Enabled = False End Sub Private Sub Form_Load() BukaDatabase Up1.Value = Year(Date) txtthn.Text = Up1 cbostatus.List(0) = "Selesai" cbostatus.List(1) = "Non Aktif" cbostatus.List(2) = "Keluar" End Sub Private Sub Form_Unload(Cancel As Integer) Koneksi.Close End Sub Private Sub txtkode_keydown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyF1 Then txtkode.Text = "" Sql = "Select Namapkt,Kodepkt,Lamabljr from tblpaket where kodepkt like '" & txtkode Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
79
& "%' order by Kodepkt" Ada = True frminfo.Caption = " >>> Info Data Paket Tahun " & txtthn & "<<<" frminfo.Grid1.Columns(0).Caption = "NAMA PAKET" frminfo.Grid1.Columns(1).Caption = "KODE PAKET" frminfo.Grid1.Columns(2).Caption = "LAMA BELAJAR" frminfo.Show vbModal, Me Ada = False txtkode.Text = frminfo.Kode txtkode_Lostfocus End If If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txtkode_Lostfocus() ckode = Trim(txtkode.Text) If ckode = Empty Then Exit Sub End If If Rspaket.RecordCount > 0 Then Rspaket.MoveFirst End If If Len(ckode) >= 3 Then Rspaket.Find ("Kodepkt = '" & ckode & "'") If Rspaket.EOF Then x = MsgBox("Maaf, Paket dengan Kode <<" & txtkode.Text & ">> tsb belum ada !", 0 + 16, "Konfirmasi") txtkode.Text = "" txtkode.SetFocus Exit Sub Else txtnama.Text = Rspaket!namapkt + " / " + "Lama Belajar " + Rspaket!Lamabljr Ada1 = False cmdproses.Enabled = False Tampildata cbostatus.Enabled = True Grid1.Enabled = True Grid1.SetFocus txtjml_siswa.Text = RsTampil.RecordCount If RsTampil.RecordCount = 0 Then x = MsgBox("Maaf. Data Siswa untuk Paket " & txtnama & " di tahun " & txtthn & " ... belum ada !!!", 0 + 64, "Pemberitahuan") Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
80
txtkode.Text = "" txtnama.Text = "" txtkode.SetFocus Exit Sub End If End If End If End Sub Private Sub Tampildata() Set RsTampil = Nothing RsTampil.Open "Select nis,Nama from " & _ " tblsiswa where Kodepkt ='" & txtkode & "'and status_siswa='aktif' and thn_masuk ='" & txtthn & "'", Koneksi Grid1.Refresh Set Grid1.DataSource = RsTampil Grid1.Columns(0).Width = 2000 Grid1.Columns(1).Width = 4000 Grid1.Columns(0).Alignment = dbgCenter Grid1.Columns(0).Caption = "N I S" Grid1.Columns(1).Caption = "NAMA SISWA" End Sub Design Form seperti gambar dibawah ini, dan berikan nama Frmrestore_status Form Restore Status Siswa
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
81
Ketik Listing dibawah ini ! Public Ada, Ada1, Valid As Boolean Public Sql, cno As String Dim RsTampil As New ADODB.Recordset Private Sub cbostatus_1_Click() Tampildata txtjml_siswa.Text = RsTampil.RecordCount Grid1.Enabled = True Grid1.SetFocus If cbostatus_1.Text = "Selesai" Then cbostatus.List(0) = "Non Aktif" cbostatus.List(1) = "Aktif" cbostatus.List(2) = "Keluar" ElseIf cbostatus_1.Text = "Non Aktif" Then cbostatus.List(0) = "Selesai" cbostatus.List(1) = "Aktif" cbostatus.List(2) = "Keluar" ElseIf cbostatus_1.Text = "Keluar" Then cbostatus.List(0) = "Selesai" cbostatus.List(1) = "Aktif" cbostatus.List(2) = "Non Aktif" End If If RsTampil.RecordCount = 0 Then x = MsgBox("Maaf. Data madyasiswa yang Status sebelumnya " & cbostatus_1 & " untuk jurusan " & txtnama & " di tahun " & txtthn & " ... belum ada !!!", 0 + 64, "Pemberitahuan") cbostatus_1.Text = "" cbostatus_1.Text = "" cbostatus_1.SetFocus Exit Sub End If End Sub Private Sub cbostatus_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab cmdproses.Enabled = True cmdproses.SetFocus End If End Sub Private Sub CmdLagi_Click() cmdproses.Enabled = False txtkode.Text = "" txtnama.Text = "" cbostatus.Text = "" Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
82
txtjml_siswa.Text = "" cbostatus_1.Text = "" cbostatus_1.Enabled = False cbostatus.Enabled = False Tampildata txtkode.SetFocus End Sub Private Sub cmdproses_Click() cno = Grid1.Columns(0) Y = MsgBox("Yakin dengan data yang anda ingin ubah???", vbYesNo + vbQuestion + vbDefaultButton2, "Konfirmasi Kembali") Select Case Y Case vbYes If cbostatus.Text = "Selesai" Then 'Or cbostatus_1.Text = "Non Aktif" Or cbostatus_1.Text = "Keluar" Then If Ada1 = False Then Rsalumni.AddNew Rsalumni!kodepkt = txtkode.Text Rsalumni!nis = cno Rsalumni!tglselesai = Date Rsalumni.Update Koneksi.Execute "update tblstatus set status='" & cbostatus & "' where nis='" & cno & "'and kodepkt='" & txtkode & "'" Koneksi.Execute "update tblsiswa set status_siswa='" & cbostatus & "' where nis='" & cno & "'and kodepkt='" & txtkode & "'" Else Koneksi.Execute "update tblstatus_madyasiswa set status='" & cbostatus & "' where nis='" & cno & "'and kode_jur='" & txtkode & "'" End If End If If cbostatus.Text = "Aktif" Then Koneksi.Execute "update tblsiswa set status_siswa='" & cbostatus & "' where nis='" & cno & "'and kodepkt='" & txtkode & "'" Koneksi.Execute "delete * from tblstatus where nis ='" & cno & "'" ElseIf cbostatus.Text = "Keluar" Then Koneksi.Execute "update tblsiswa set status_siswa='" & cbostatus & "' where nis='" & cno & "'and kodepkt='" & txtkode & "'" Koneksi.Execute "update tblstatus set status='" & cbostatus & "' where nis='" & cno & "'and kodepkt='" & txtkode & "'" ElseIf cbostatus.Text = "Non Aktif" Then Koneksi.Execute "update tblsiswa set status_siswa='" & cbostatus & "' where nis='" & cno & "'and kodepkt='" & txtkode & "'" Koneksi.Execute "update tblstatus set status='" & cbostatus & "' where nis='" & cno Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
83
& "'and kodepkt='" & txtkode & "'" End If If cbostatus.Text = "Aktif" And cbostatus_1.Text = "Selesai" Then Koneksi.Execute "update tblsiswa set status_siswa='" & cbostatus & "' where nis='" & cno & "'and kodepkt='" & txtkode & "'" Koneksi.Execute "delete * from tblstatus where nis ='" & cno & "'" Koneksi.Execute "delete * from tblalumni where nis ='" & cno & "'" ElseIf cbostatus.Text = "Non Aktif" Or cbostatus.Text = "Keluar" And cbostatus_1.Text = "Selesai" Then Koneksi.Execute "update tblsiswa set status_siswa='" & cbostatus & "' where nis='" & cno & "'and kodepkt='" & txtkode & "'" Koneksi.Execute "delete * from tblalumni where nis ='" & cno & "'" ElseIf cbostatus.Text = "Keluar" And cbostatus_1.Text = "Selesai" Then Koneksi.Execute "update tblsiswa set status_siswa='" & cbostatus & "' where nis='" & cno & "'and kodepkt='" & txtkode & "'" Koneksi.Execute "delete * from tblalumni where nis ='" & cno & "'" End If Tampildata txtjml_siswa.Text = RsTampil.RecordCount If RsTampil.RecordCount > 0 Then cmdproses.Enabled = True cmdproses.SetFocus Else cmdproses.Enabled = False cmdkeluar.SetFocus End If Case vbNo cmdproses.Enabled = False cbostatus.Text = "" txtjml_siswa.Text = "" cmdkeluar.SetFocus txtjml_siswa.Text = RsTampil.RecordCount End Select End Sub Private Sub Grid1_Click() cbostatus.Enabled = True cbostatus.SetFocus End Sub Private Sub Grid1_KeyDown(KeyCode As Integer, Shift As Integer) cbostatus.Enabled = True cbostatus.SetFocus Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
84
End Sub Private Sub Up1_Change() txtthn.Text = Up1 End Sub Private Sub CmdKeluar_Click() Unload Me mdmenuutama.Enabled = True End Sub Private Sub Form_Activate() Grid1.Enabled = False cbostatus_1.Enabled = False cbostatus.Enabled = False cmdproses.Enabled = False mdmenuutama.Enabled = False End Sub Private Sub Form_Load() BukaDatabase Up1.Value = Year(Date) txtthn.Text = Up1 cbostatus_1.List(0) = "Selesai" cbostatus_1.List(1) = "Non Aktif" cbostatus_1.List(2) = "Keluar" End Sub Private Sub Form_Unload(Cancel As Integer) Koneksi.Close End Sub Private Sub txtkode_keydown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyF1 Then txtkode.Text = "" Sql = "Select Namapkt,Kodepkt,Lamabljr from tblpaket where kodepkt like '" & txtkode & "%' order by Kodepkt" Ada = True frminfo.Caption = " >>> Info Data Paket Tahun " & txtthn & "<<<" frminfo.Grid1.Columns(0).Caption = "NAMA PAKET" frminfo.Grid1.Columns(1).Caption = "KODE PAKET" frminfo.Grid1.Columns(2).Caption = "LAMA BELAJAR" frminfo.Show vbModal, Me Ada = False txtkode.Text = frminfo.Kode txtkode_Lostfocus Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
85
End If If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txtkode_Lostfocus() ckode = Trim(txtkode.Text) If ckode = Empty Then Exit Sub End If If Rspaket.RecordCount > 0 Then Rspaket.MoveFirst End If If Len(ckode) >= 3 Then Rspaket.Find ("Kodepkt = '" & ckode & "'") If Rspaket.EOF Then x = MsgBox("Maaf, Paket dengan Kode <<" & txtkode.Text & ">> tsb belum ada !", 0 + 16, "Konfirmasi") txtkode.Text = "" txtkode.SetFocus Exit Sub Else txtnama.Text = Rspaket!namapkt + " / " + "Lama Belajar " + Rspaket!Lamabljr Ada1 = False cmdproses.Enabled = False Tampildata cbostatus_1.Enabled = True Grid1.Enabled = False cbostatus_1.SetFocus End If End If End Sub Private Sub Tampildata() Set RsTampil = Nothing RsTampil.Open "select tblstatus.nis,tblsiswa.nama,tblstatus.status,tblstatus.tgl_ubah from tblstatus,tblsiswa where tblstatus.kodepkt='" & txtkode & "' and right(tblstatus.tgl_ubah,4)='" & txtthn & "' and tblstatus.nis =tblsiswa.nis and tblstatus.status='" & Trim(cbostatus_1) & "' order by tgl_ubah", Koneksi, adOpenDynamic, adLockOptimistic Grid1.Refresh
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
86
Set Grid1.DataSource = RsTampil Grid1.Columns(0).Width = 1500 Grid1.Columns(1).Width = 3500 Grid1.Columns(2).Width = 1000 Grid1.Columns(3).Width = 1000 Grid1.Columns(0).Alignment = dbgCenter Grid1.Columns(0).Caption = "N I S" Grid1.Columns(1).Caption = "NAMA SISWA" Grid1.Columns(2).Caption = "STATUS" Grid1.Columns(3).Caption = "TGL.UBAH" End Sub Design Form Laporan seperti gambar dibawah ini, dan berikan nama Frmcetaksiswaperthn Form Laporan Siswa Per Tahun
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
87
Ketik Listing dibawah ini ! Dim RsTampil As New ADODB.Recordset Private Sub cmdcetak_Click() If Opthn = True Then crpcetak1.ReportFileName = App.Path & "\" & "rptlap_siswa_pertahun_01.rpt" crpcetak1.SelectionFormula = " {tblsiswa.thn_masuk} ='" & txtth1 & "'" crpcetak1.RetrieveDataFiles crpcetak1.WindowState = crptMaximized crpcetak1.Action = 1 Else crpcetak1.ReportFileName = App.Path & "\" & "rptlap_siswa_pertahun_02.rpt" crpcetak1.SelectionFormula = " {tblsiswa.thn_masuk} ='" & txtth1 & "' and {tblsiswa.kodepkt} ='" & txtkodepkt & "'" crpcetak1.RetrieveDataFiles crpcetak1.WindowState = crptMaximized crpcetak1.Action = 1 End If End Sub Private Sub CmdKeluar_Click() Unload Me End Sub Private Sub cmdtampil_Click() If Opthn = True Then Tampildata1 If RsTampil.RecordCount = 0 Then x = MsgBox("Maaf. Data siswa di Tahun " & txtth1 & " tersebut belum ada !", 0 + 64, "Konfirmasi") cmdkeluar.SetFocus End If Else If txtkodepkt.Text = Empty Then x = MsgBox("Anda belum memasukkan kode paket, silahkan tekan F1 untuk bantuan !", 0 + 64, "Konfirmasi") txtkodepkt.SetFocus Tampildata2 Exit Sub End If ckode = Trim(txtkodepkt.Text) If Rspaket.RecordCount > 0 Then Rspaket.MoveFirst Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
88
End If If Len(ckode) >= 3 Then Rspaket.Find ("Kodepkt = '" & ckode & "'") If Rspaket.EOF Then x = MsgBox("Maaf, Paket dengan Kode <<" & txtkodepkt.Text & ">> tsb tidak ada !", 0 + 16, "Konfirmasi") txtkodepkt.Text = "" txtnamapkt.Text = "" txtkodepkt.SetFocus Tampildata2 frmcetaksiswaperthn.Refresh Exit Sub Else txtnamapkt.Text = Rspaket!namapkt + " / " + Rspaket!Lamabljr Ada1 = False Tampildata2 If RsTampil.RecordCount = 0 Then x = MsgBox("Maaf. Data siswa untuk paket " & txtkodepkt & " di Tahun " & txtth1 & " tersebut belum ada !", 0 + 64, "Konfirmasi") cmdkeluar.SetFocus End If End If End If End If End Sub Private Sub Form_Load() Upthn1.Value = Year(Date) txtth1Text = Upthn1 Upthn2.Value = Year(Date) txtth2.Text = Upthn2 BukaDatabase Opthn = True End Sub Private Sub Form_Unload(Cancel As Integer) Koneksi.Close End Sub Private Sub Opthn_Click() txtkodepkt.Enabled = False txtkodepkt.Text = "" txtnamapkt.Text = "" Tampildata2 End Sub Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
89
Private Sub optpaket_Click() txtkodepkt.Enabled = True txtkodepkt.SetFocus Tampildata2 End Sub Private Sub Upthn1_Change() txtth1.Text = Upthn1 End Sub Private Sub Upthn2_Change() txtth2.Text = Upthn2 End Sub Private Sub Tampildata1() Set RsTampil = Nothing RsTampil.Open "Select nis,Nama,pend_terakhir from " & _ " tblsiswa where thn_masuk ='" & txtth1 & "'", Koneksi Grid1.Refresh Set Grid1.DataSource = RsTampil Grid1.Columns(0).Width = 1750 Grid1.Columns(1).Width = 3000 Grid1.Columns(2).Width = 1500 Grid1.Columns(0).Alignment = dbgCenter 'Grid1.Columns(3).Alignment = dbgCenter Grid1.Columns(0).Caption = "N I S" Grid1.Columns(1).Caption = "NAMA SISWA / i" Grid1.Columns(2).Caption = "PEND.AKHIR" End Sub Private Sub Tampildata2() Set RsTampil = Nothing RsTampil.Open "Select nis,Nama,pend_terakhir from " & _ " tblsiswa where thn_masuk ='" & txtth2 & "' and kodepkt='" & txtkodepkt & "'", Koneksi Grid1.Refresh Set Grid1.DataSource = RsTampil Grid1.Columns(0).Width = 1750 Grid1.Columns(1).Width = 3000 Grid1.Columns(2).Width = 1500 Grid1.Columns(0).Alignment = dbgCenter 'Grid1.Columns(3).Alignment = dbgCenter Grid1.Columns(0).Caption = "N I S" Grid1.Columns(1).Caption = "NAMA SISWA / i" Grid1.Columns(2).Caption = "PEND.AKHIR" End Sub
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
90
Desain Laporan Siswa PerTahun pada Cristal Report, seperti masing-masing gambar berikut ini : Nama Report : RptLap_siswa_pertahun_01
Nama Report : RptLap_siswa_pertahun_02
Catatan : Kedua Laporan siswa tersebut diatas, terbentuk dari 2 tabel : 1). Tabel tblsiswa & 2).tabel tblpaket
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
91
Design Form Laporan seperti gambar dibawah ini, dan berikan nama Frmcetakmultibayar Form Cetak Multi Bayar
Ketik Listing dibawah ini ! Public Ada, Ada1, Valid As Boolean Public Sql, ck As String Public T1, B1, Th1 As Integer Dim RsTampil As New ADODB.Recordset Private Sub cmdcetak_Click() ckode = Trim(txtkode.Text) ck = Trim(txtnis.Text) If ckode = Empty Then x = MsgBox(" Anda belum memasukkan kode paket,silahkan tekan F1 !", 0 + 64, "Konfirmasi") txtkode.SetFocus Exit Sub End If If ck = Empty Then x = MsgBox(" Anda belum memilih Data Siswa,silahkan tekan F1 !", 0 + 64, "Konfirmasi") txtnis.SetFocus Exit Sub End If coleh = frmreading.TxtNamap crpcetak2.ReportFileName = App.Path & "\" & "rptkwitansi_multi.rpt" rtgl = "{tblpembayaran.TglByr} = date( " & Th1 & "," & B1 & "," & T1 & ")" crpcetak2.SelectionFormula = " " & rtgl & " and {tblpembayaran.ta} ='" & txtthn & "' and Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
92
{tblpembayaran.kodepkt} ='" & txtkode & "' and {tblpembayaran.nis} ='" & txtnis & "'" crpcetak2.Formulas(0) = "vmenerima ='" & coleh & "'" Crpcetak2.RetrieveDataFiles crpcetak2.WindowState = crptMaximized crpcetak2.CopiesToPrinter = 1 crpcetak2.Destination = crptToPrinter crpcetak2.Action = 1 End Sub Private Sub CmdLagi_Click() txtkode.Text = "" txtnis.Text = "" txtnama_1.Text = "" txtnama.Text = "" txtkode.SetFocus End Sub Private Sub Up1_Change() txtthn.Text = Up1 End Sub Private Sub CmdKeluar_Click() Unload Me mdmenuutama.Enabled = True End Sub Private Sub Form_Activate() mdmenuutama.Enabled = False End Sub Private Sub Form_Load() BukaDatabase dtpbayar = Date dtpbayar_LostFocus Up1.Value = Year(Date) txtthn.Text = Up1 End Sub Private Sub dtpbayar_LostFocus() T1 = Left(dtpbayar, 2) B1 = Mid(dtpbayar, 4, 2) Th1 = Right(dtpbayar, 4) End Sub
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
93
Private Sub Form_Unload(Cancel As Integer) Koneksi.Close End Sub Private Sub txtkode_keydown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyF1 Then txtkode.Text = "" Sql = "Select Namapkt,Kodepkt,Lamabljr from tblpaket where kodepkt like '" & txtkode & "%' order by Kodepkt" Ada = True frminfo.Caption = ">>> Info Data Paket Pelatihan Tahun " & txtthn & "<<<" frminfo.Show vbModal, Me Ada = False txtkode.Text = frminfo.Kode txtkode_Lostfocus End If If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txtkode_Lostfocus() ckode = Trim(txtkode.Text) If ckode = Empty Then Exit Sub End If If Rspaket.RecordCount > 0 Then Rspaket.MoveFirst End If If Len(ckode) >= 3 Then Rspaket.Find ("Kodepkt = '" & ckode & "'") If Rspaket.EOF Then x = MsgBox("Maaf, Paket dengan Kode <<" & txtkode.Text & ">> tsb belum ada !", 0 + 16, "Konfirmasi") txtkode.Text = "" txtkode.SetFocus Exit Sub Else txtnama.Text = Rspaket!namapkt + " / " + Rspaket!Lamabljr Ada1 = False End If End If End Sub
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
94
Private Sub Txtnis_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyF1 Then txtnis.Text = "" Sql = "Select Alamat_Asal,nis,nama from tblsiswa Where thn_masuk='" & txtthn & "'and kodepkt='" & txtkode & "' and status_siswa='Aktif' order by nis" Ada = True frminfo.Caption = " >>> Info Data Siswa Tahun " & txtthn & " <<<" frminfo.Show vbModal, Me Ada = False txtnis.Text = frminfo.Kode txtnis_Lostfocus End If If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txtnis_Lostfocus() ckode = Trim(txtnis.Text) If ckode = Empty Then Exit Sub End If If Rssiswa.RecordCount > 0 Then Rssiswa.MoveFirst End If Set Rssiswa = Nothing Rssiswa.Open "[tblsiswa] where Kodepkt = '" & txtkode & "'" & _ "and nis = '" & txtnis & " ' And " & _ "Kodepkt='" & txtkode & "'and thn_masuk='" & txtthn & "'and status_siswa='Aktif'", Koneksi, adOpenDynamic, adLockOptimistic If Rssiswa.EOF Then x = MsgBox("Sorry, Siswa dengan No. Induk " & txtnis & " tersebut belum terdaftar", 0 + 64, "Konfirmasi") txtnis.Text = "" txtnis.Enabled = True txtnis.SetFocus Ada1 = False Else txtnama_1.Text = Rssiswa!nama Ada1 = True End If End Sub
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
95
Desain Laporan pembayaran pada Cristal Report, seperti gambar berikut ini : Nama Report : Rptkwitansi_multi
Catatan : Laporan pembayaran diatas, terbentuk dari 3 tabel : 1). Tabel tblsiswa, 2).tabel tblpaket, 3).Tabel Tblpembayaran Desain Laporan Bukti pembayaran pada Cristal Report, seperti gambar berikut ini : Nama Report : Rptlaporan_bukti
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
96
Design Form seperti gambar dibawah ini, dan berikan nama Frmpassword Form Password
Ketik Listing dibawah ini ! Private Sub CmdBatal_Click() txtnm.Text = "" txtpas.Text = "" cmdsimpan.Enabled = False cmdhapus.Enabled = False txtnm.SetFocus End Sub Private Sub CmdHapus_Click() cmdhapus.Enabled = False RsLogin.MoveFirst RsLogin.Find ("Nama_User = '" & Trim(txtnm.Text) & "'") If RsLogin.EOF Then Y = MsgBox("Nama User & Password Anda tidak dikenal ???", vbOKOnly, "Konfirmasi") CmdBatal_Click Exit Sub Else If RsLogin.RecordCount = 1 Then Y = MsgBox("Maaf Password tidak dapat dihapus ?", vbOKOnly, "Konfirmasi") CmdBatal_Click Exit Sub Else Y = MsgBox("Benar Anda Ingin Hapus ???", vbYesNo + vbQuestion + vbDefaultButton2, "Hapus Password") Select Case Y Case vbYes RsLogin.Delete Case vbNo End Select End If Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
97
End If CmdBatal_Click End Sub Private Sub CmdKeluar_Click() Unload Me End Sub Private Sub CmdSimpan_Click() IsiTabel CmdBatal_Click End Sub Private Sub Form_Load() BukaDatabase txtnm.Text = "" txtpas.Text = "" cmdsimpan.Enabled = False cmdhapus.Enabled = False End Sub Private Sub IsiTabel() RsLogin.MoveFirst RsLogin.Find ("Nama_User = '" & Trim(txtnm.Text) & "'") If RsLogin.EOF Then RsLogin.AddNew RsLogin!nama_user = txtnm RsLogin!Sandi = txtpas.Text RsLogin.Update Else RsLogin.Requery RsLogin!nama_user = txtnm RsLogin!Sandi = txtpas.Text RsLogin.Update End If End Sub Private Sub Form_Unload(Cancel As Integer) Koneksi.Close End Sub
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
98
Private Sub txtnm_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Private Sub txtpas_Change() If Len(txtnm.Text) > 1 And Len(txtpas.Text) > 1 Then cmdsimpan.Enabled = True cmdhapus.Enabled = True Else cmdsimpan.Enabled = False cmdhapus.Enabled = False End If End Sub Private Sub txtpas_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then SendKeys vbTab End If End Sub Design Form seperti gambar dibawah ini, dan berikan nama FrmAbout Form About Program
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
99
Design Form seperti gambar dibawah ini, dan berikan nama Frmreading Form Reading
Ketik Listing dibawah ini ! Private Sub Form_Load() BukaDatabase mdmenuutama.Enabled = False mdmenuutama.Show mdmenuutama.stb.Panels(4).Text = Me.Caption End Sub Private Sub CmdBatal_Click() End End Sub Private Sub cmdok_Click() RsLogin.MoveFirst RsLogin.Find ("Nama_User = '" & Trim(TxtNamap.Text) & "'") If RsLogin.EOF Then x = MsgBox("Maaf !, Nama User Salah Ulangi Lagi ", 0 + 16, "Konfirmasi") TxtNamap.SetFocus Exit Sub End If If TxtNamap = RsLogin!nama_user And TxtPass = RsLogin!Sandi Then frmreading.Hide Koneksi.Close mdmenuutama.Enabled = True mdmenuutama.stb.Panels(1).Text = frmreading.TxtNamap.Text mdmenuutama.Show Else x = MsgBox("Maaf !, Sandi Salah Ulangi Lagi ", 0 + 16, "Konfirmasi") TxtPass.SetFocus Exit Sub End If End Sub Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
100
Private Sub Form_Unload(Cancel As Integer) Koneksi.Close End Sub Private Sub TxtNamap_GotFocus() TxtNamap.SelStart = 0 TxtNamap.SelLength = Len(TxtNamap) End Sub Private Sub TxtNamap_KeyPress(keyascii As Integer) If keyascii = 13 Then SendKeys vbTab End If End Sub Private Sub TxtPass_GotFocus() TxtPass.SelStart = 0 TxtPass.SelLength = Len(TxtPass) End Sub Private Sub TxtPass_KeyPress(keyascii As Integer) If keyascii = 13 Then cmdok_Click End If End Sub Design Form seperti gambar dibawah ini, dan berikan nama FrmInfo Form Informasi Bantuan
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
101
Ketik Listing dibawah ini ! Public Kode, Teks As String Private Sub Grid1_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyEscape Then Kode = "" Teks = "" Unload Me Exit Sub End If If KeyCode = vbKeyReturn Then If Ado.Recordset.RecordCount = 0 Then Kode = "" Teks = "" Else Kode = Grid1.Columns(1) Teks = Grid1.Columns(0) End If Unload Me End If End Sub Private Sub Form_Load() Ado.ConnectionString = Koneksi If frmsiswa.Ada Then Ado.RecordSource = frmsiswa.Sql Ado.Refresh ElseIf frmjenisbiaya.Ada Then Ado.RecordSource = frmjenisbiaya.Sql Ado.Refresh ElseIf frmcalonsiswa.Ada Then Ado.RecordSource = frmcalonsiswa.Sql Ado.Refresh ElseIf frmubahstatus.Ada Then Ado.RecordSource = frmubahstatus.Sql Ado.Refresh ElseIf frmrestore_status.Ada Then Ado.RecordSource = frmrestore_status.Sql Ado.Refresh ElseIf frmsertifikat.Ada Then Ado.RecordSource = frmsertifikat.Sql Ado.Refresh ElseIf frmpembayaran.Ada Then Ado.RecordSource = frmpembayaran.Sql Ado.Refresh Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
102
ElseIf frmperiksa.Ada Then Ado.RecordSource = frmperiksa.Sql Ado.Refresh ElseIf frmcetakmultibayar.Ada Then Ado.RecordSource = frmcetakmultibayar.Sql Ado.Refresh End If Grid1.Col = 0 Grid1.Columns(0).Width = 2500 Grid1.Columns(1).Width = 1500 Grid1.Columns(1).Alignment = dbgCenter End Sub Rancanglah Menu Utama dengan menggunakan fasilitas MDIForm, seperti gambar dibawah ini, dan berikan nama mdmenuutama
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
103
Ketik Listing dibawah ini ! Dim jdl As String Private Sub mnabout_Click() frmabout.Show End Sub Private Sub mnalihan_Click() frmubahstatus.Show End Sub Private Sub mnalumni_Click() frmsertifikat.Show End Sub Private Sub mnbiaya_Click() frmjenisbiaya.Show End Sub Private Sub mncalon_Click() frmcalonsiswa.Show End Sub Private Sub mncetak1_Click() frmcetaksiswaperthn.Show End Sub Private Sub mnkelas_Click() frmkelas.Show End Sub Private Sub mnmulti_Click() frmcetakmultibayar.Show End Sub Private Sub mnpaket_Click() frmpaket.Show End Sub Private Sub mnpembayaran_Click() frmpembayaran.Show End Sub Private Sub mnperiksa_Click() frmperiksa.Show End Sub Private Sub mnrestore_Click() frmrestore_status.Show End Sub Private Sub mnsiswa_Click() frmsiswa.Show End Sub Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
104
Private Sub mnubah_Click() frmpassword.Show End Sub Private Sub Timer1_Timer() jdl = Mid(jdl, 2, Len(jdl) - 1) & Mid(jdl, 1, 1) Me.Caption = jdl stb.Panels(3).Text = Format(Time, "hh:mm:ss AM/PM") stb.Panels(3).Width = 1800 stb.Panels(3).Alignment = sbrCenter End Sub Private Sub MDIForm_Activate() stb.Panels(4).Text = "Sistem Administrasi Pelatihan Komputer Privat Dellsa Computer Banggai" End Sub Private Sub MDIForm_Load() Me.Caption = "<<< Sistem Administrasi Pelatihan Komputer Privat Dellsa Computer Banggai >>>" jdl = Me.Caption frmreading.Show frmreading.TxtNamap.SetFocus stb.Panels(1).Text = frmreading.TxtNamap.Text stb.Panels(1).Width = 3000 stb.Panels(2).Text = Format(Date, "Dddd, dd Mmmm yyyy") stb.Panels(2).Alignment = sbrCenter stb.Panels(2).Width = 2700 stb.Panels(4).Text = "Sistem Administrasi Pelatihan Komputer Privat Dellsa Computer Banggai" stb.Panels(4).Width = 7000 End Sub Private Sub mnkeluar_Click() Pesan = MsgBox("Anda yakin mau keluar !", 4 + 256 + 32, "Konfirmasi") If Pesan = 6 Then End Else mdmenuutama.Show End If End Sub ----------------------------------------------------------------------------------------------------------------------------Wasiat Programmer : Program ini masih terus dikembangkan, gambar form yang ada sudah didesain kembali serta dirubah tampilannya, dan juga ditambahkan lagi form baru sebanyak 30 form serta Output (laporan) sampai sekarang ini (16/02/2008) sebanyak 28 report. Jika anda merasa program ini banyak kekurangannya berarti PR anda untuk mengembangkannya. Perlu anda ingat, salah satu kesuksesan program anda terletak pada kemudahan dalam membackup dan keamanan datanya. Data (database) lebih mahal daripada programnya ... Selamat mencoba ... dan terus berkarya !!!
Bimbingan Visual Basic untuk kalangan terbatas
By. Yanto Naim - TI
