Assalamualikum Wr.Wb
Hallo Kita Bertemu lagi dalam Lanjutan Pembuatan Aplikasi Penerimaan Siswa Baru Part 2. Kali Ini Saya akan Menjelaskan mengenai pembuatan Form untuk Menu File pada Aplikasi PSB.semoga anda semua dapat mengerti dan paham. Untuk lebih tepatnya kita langsung aja ke tahapan pembuatan untuk menu File yang meliputi :
-SubMenu Panitia
Control |
Name |
Caption |
Frame |
Frame3 |
Data Panitia Penerimaan Siswa Baru |
Label |
Label4 |
NIP |
Label |
Label5 |
Nama |
Label |
Label6 |
Alamat |
Label |
Label7 |
Jabatan |
TextBox |
TxtNIP |
- |
TextBox |
TxtNama |
- |
TextBox |
TxtAlamat |
- |
ComboBox |
CboJabatan |
- |
Frame |
Frame4 |
Proses |
CommandButon |
CmdTambah |
&Tambah |
CommandButon |
CmdUbah |
&Ubah |
CommandButon |
CmdSimpan |
&Simpan |
CommandButon |
CmdBatal |
&Batal |
CommandButon |
CmdHapus |
&Hapus |
CommandButon |
CmdKeluar |
&Keluar |
Adodc |
Adodc1 |
Adodc1 |
DataGrid |
DataGrid1 |
- |
-Buat Design Data Panitia Penerimaan siswa Seperti di bawah ini.
-Kita Masukan Source Code Untuk Data Psb berikut.
Public baru As Boolean Private Sub cmdBatal_Click() KunciTeks True TombolAwal True KosongkanForm End Sub Private Sub cmdHapus_Click() On Error GoTo hapusErr Dim pil pil = MsgBox("Apakah anda yakin data ini akan dihapus ?", vbQuestion + vbYesNo + vbDefaultButton2, "Konfirmasi") If pil = vbYes Then Adodc1.Recordset.Delete MsgBox "Data Berhasil Dihapus !", vbInformation, "Informasi" End If Exit Sub hapusErr: MsgBox "Terdapat kesalahan ! " & Err.Description, vbCritical, "Peringatan" End Sub Private Sub cmdKeluar_Click() Unload Me End Sub Private Sub cmdSimpan_Click() On Error GoTo simpanErr If txtNIK.Text = Empty Or _ txtNama.Text = Empty Or _ txtAlamat.Text = Empty Or _ cboJabatan.Text = Empty Then MsgBox "Masih ada kolom yang kosong ! Silahkan lengkapi terlebih dahulu !", vbExclamation, "Peringatan" Else Dim rscek As ADODB.Recordset Set rscek = New ADODB.Recordset rscek.Open "select * from psb where NIK='" & txtNIK.Text & "'", Conn If Not rscek.EOF And baru Then MsgBox "Data PSB dengan NIK " & txtNIK.Text & " sudah ada !", vbExclamation, "Peringatan" cboJabatan.SetFocus Else With Adodc1.Recordset If baru Then .AddNew !NIK = txtNIK.Text !nama = txtNama.Text !alamat = txtAlamat.Text !jabatan = cboJabatan.Text .Update MsgBox "Data berhasil disimpan !", vbInformation, "Informasi" KunciTeks True TombolAwal True KosongkanForm End With End If End If Exit Sub simpanErr: MsgBox "Terdapat kesalahan ! " & Err.Description, vbCritical, "Peringatan" End Sub Private Sub cmdTambah_Click() baru = True KunciTeks False TombolAwal False txtNIK.SetFocus End Sub Sub TombolAwal(kunci As Boolean) cmdTambah.Enabled = kunci cmdSimpan.Enabled = Not kunci cmdBatal.Enabled = Not kunci cmdUbah.Enabled = kunci cmdHapus.Enabled = kunci cmdKeluar.Enabled = kunci End Sub Private Sub cmdUbah_Click() On Error GoTo ubahErr KunciTeks False TombolAwal False baru = False With Adodc1.Recordset txtNIK.Text = !NIK txtNama.Text = !nama txtAlamat.Text = !alamat cboJabatan.Text = !jabatan End With txtNIK.SetFocus Exit Sub ubahErr: MsgBox "Terdapat kesalahan ! " & Err.Description, vbCritical, "Peringatan" End Sub Private Sub Form_Load() koneksi KunciTeks True TombolAwal True Adodc1.ConnectionString = Conn.ConnectionString Adodc1.RecordSource = "select * from psb" Adodc1.Refresh Set DataGrid1.DataSource = Adodc1 cboJabatan.Clear cboJabatan.AddItem "Ketua" cboJabatan.AddItem "Sekretaris" cboJabatan.AddItem "Bendahara" cboJabatan.AddItem "Anggota" End Sub Private Sub Form_Activate() Dim i As Integer For i = 0 To 3 DataGrid1.Columns(i).Locked = True Next i End Sub Sub KosongkanForm() txtNIK.Text = Empty txtNama.Text = Empty txtAlamat.Text = Empty cboJabatan.Text = Empty End Sub Sub KunciTeks(kunci As Boolean) txtNIK.Enabled = Not kunci txtNama.Enabled = Not kunci txtAlamat.Enabled = Not kunci cboJabatan.Enabled = Not kunci End Sub Private Sub txtNIK_KeyPress(KeyAscii As Integer) HanyaAngka KeyAscii End Sub
- Untuk Selanjutnya Anda buat SubMenu Calon Siswa.
Control |
Name |
Caption |
Frame |
Frame5 |
Calon Siswa Baru |
Label |
Label8 |
No.Pendaftaran |
Label |
Label9 |
Tanggal Daftar |
Label |
Label10 |
Nama |
Label |
Label11 |
Nem |
Label |
Label12 |
Jenis_Kelamin |
Label |
Label13 |
Tempat Lahir |
Label |
Label14 |
Tanggal Lahir |
Label |
Label15 |
Agama |
Label |
Label16 |
Anak Ke- |
Label |
Label17 |
Status dalam Kel. |
Label |
Label18 |
Alamat |
Frame |
Frame6 |
Sekolah Asal |
Label |
Label19 |
Nama Sekolah |
Label |
Label20 |
Alamat |
Frame |
Frame7 |
Orang Tua |
Label |
Label21 |
Nama Ayah |
Label |
Label22 |
Nama Ibu |
Label |
Label23 |
Alamat |
Label |
Label24 |
Pekerjaan ayah |
Label |
Label25 |
Pekerjaan Ibu |
Frame |
Frame8 |
Wali |
Label |
Label26 |
Nama Wali |
Label |
Label27 |
Alamat |
Label |
Label28 |
Pekerjaan Wali |
Frame |
Frame9 |
Pencarian |
Label |
Label29 |
Berdasarkan |
Label |
Label30 |
Input |
TextBox |
TextBox |
NoDaftar |
-Untuk Selanjutnya lihat pada gambar di bawah ini.
-Masukan Source Code untuk Calon Siswa
Public baru As Boolean Private Sub cmdBatal_Click() KunciTeks True TombolAwal True KosongkanForm End Sub Private Sub cmdHapus_Click() On Error GoTo hapusErr Dim pil pil = MsgBox("Apakah anda yakin data ini akan dihapus ?", vbQuestion + vbYesNo + vbDefaultButton2, "Konfirmasi") If pil = vbYes Then Adodc1.Recordset.Delete MsgBox "Data Berhasil Dihapus !", vbInformation, "Informasi" End If Exit Sub hapusErr: MsgBox "Terdapat kesalahan ! " & Err.Description, vbCritical, "Peringatan" End Sub Private Sub cmdKeluar_Click() Unload Me End Sub Private Sub cmdSimpan_Click() On Error GoTo simpanErr If txtNoDaftar.Text = Empty Or _ txtNama.Text = Empty Or _ (optJK(0).Value = False And _ optJK(1).Value = False) Or _ txtTmptLhr.Text = Empty Or _ cboAnakKe.Text = Empty Or _ cboStatus.Text = Empty Or _ txtAlamat.Text = Empty Or _ txtNamaSklh.Text = Empty Or _ txtNEM.Text = Empty Or _ txtAlamatSklh.Text = Empty Or _ txtAyah.Text = Empty Or _ txtIbu.Text = Empty Or _ txtAlamatOrtu.Text = Empty Or _ txtPekerjaanAyah.Text = Empty Or _ txtPekerjaanIbu.Text = Empty Then MsgBox "Masih ada kolom yang kosong ! Silahkan lengkapi terlebih dahulu !", vbExclamation, "Peringatan" Else With Adodc1.Recordset If baru Then .AddNew !no_daftar = txtNoDaftar.Text !nama = txtNama.Text If optJK(0).Value = True Then !JK = "Laki-laki" ElseIf optJK(1).Value = True Then !JK = "Perempuan" End If !tmpt_lhr = txtTmptLhr.Text !tgl_lhr = Format(dtTglLhr.Value, "d/mm/yyyy") !agama = cboAgama.Text !anak_ke = cboAnakKe.Text !Status = cboStatus.Text !alamat = txtAlamat.Text !nem = txtNEM.Text !tgl_daftar = Format(dtTglDaftar.Value, "d/mm/yyyy") !sekolah_asal = txtNamaSklh.Text !alamat_sekolah = txtAlamatSklh.Text !ayah = txtAyah.Text !ibu = txtIbu.Text !alamat_ortu = txtAlamatOrtu.Text !pek_ayah = txtPekerjaanAyah.Text !pek_ibu = txtPekerjaanIbu.Text !wali = txtWali.Text !alamat_wali = txtAlamatWali.Text !pek_wali = txtPekWali.Text .Update MsgBox "Data berhasil disimpan !", vbInformation, "Informasi" KunciTeks True TombolAwal True KosongkanForm End With End If Exit Sub simpanErr: MsgBox "Terdapat kesalahan ! " & Err.Description, vbCritical, "Peringatan" End Sub Private Sub cmdTambah_Click() baru = True KunciTeks False TombolAwal False txtNoDaftar.SetFocus cboAgama.Text = "Islam" 'txtNoDaftar.Text = GetAutoNumber("", "", 3) 'txtNoDaftar.Text = GetAutoNumber(Right(CStr(Year(Now)), 2), , 3) setID Adodc1.ConnectionString = Conn.ConnectionString Adodc1.RecordSource = "select * from calon order by no_daftar" Adodc1.Refresh Set DataGrid1.DataSource = Adodc1 End Sub Sub TombolAwal(kunci As Boolean) cmdTambah.Enabled = kunci cmdSimpan.Enabled = Not kunci cmdBatal.Enabled = Not kunci cmdUbah.Enabled = kunci cmdHapus.Enabled = kunci cmdKeluar.Enabled = kunci cmdRefresh.Enabled = kunci End Sub Private Sub cmdUbah_Click() On Error GoTo ubahErr KunciTeks False TombolAwal False baru = False With Adodc1.Recordset txtNoDaftar.Text = !no_daftar txtNama.Text = !nama If !JK = "Laki-laki" Then optJK(0).Value = True ElseIf !JK = "Perempuan" Then optJK(1).Value = True End If txtTmptLhr.Text = !tmpt_lhr dtTglLhr.Value = !tgl_lhr cboAgama.Text = !agama cboAnakKe.Text = !anak_ke cboStatus.Text = !Status txtAlamat.Text = !alamat txtNEM.Text = !nem dtTglDaftar.Value = !tgl_daftar txtNamaSklh.Text = !sekolah_asal txtAlamatSklh.Text = !alamat_sekolah txtAyah.Text = !ayah txtIbu.Text = !ibu txtAlamatOrtu.Text = !alamat_ortu txtPekerjaanAyah.Text = !pek_ayah txtPekerjaanIbu.Text = !pek_ibu txtWali.Text = !wali txtAlamatWali.Text = !alamat_wali txtPekWali.Text = !pek_wali End With txtNoDaftar.SetFocus Exit Sub ubahErr: MsgBox "Terdapat kesalahan ! " & Err.Description, vbCritical, "Peringatan" End Sub Private Sub Form_Load() koneksi KunciTeks True TombolAwal True Adodc1.ConnectionString = Conn.ConnectionString Adodc1.RecordSource = "select * from calon order by no_daftar" Adodc1.Refresh Set DataGrid1.DataSource = Adodc1 dtTglLhr.Value = Now dtTglDaftar.Value = Now End Sub Private Sub Form_Activate() Dim i As Integer For i = 0 To 20 DataGrid1.Columns(i).Locked = True Next i End Sub Sub KosongkanForm() txtNoDaftar.Text = Empty txtNama.Text = Empty optJK(0).Value = False optJK(1).Value = False txtTmptLhr.Text = Empty dtTglLhr.Value = Now cboAgama.Text = Empty cboAnakKe.Text = Empty cboStatus.Text = Empty txtAlamat.Text = Empty txtNEM.Text = Empty dtTglDaftar.Value = Now txtNamaSklh.Text = Empty txtAlamatSklh.Text = Empty txtAyah.Text = Empty txtIbu.Text = Empty txtAlamatOrtu.Text = Empty txtPekerjaanAyah.Text = Empty txtPekerjaanIbu.Text = Empty txtWali.Text = Empty txtAlamatWali.Text = Empty txtPekWali.Text = Empty End Sub Sub KunciTeks(kunci As Boolean) txtNoDaftar.Enabled = Not kunci txtNama.Enabled = Not kunci optJK(0).Enabled = Not kunci optJK(1).Enabled = Not kunci txtTmptLhr.Enabled = Not kunci dtTglLhr.Enabled = Not kunci cboAgama.Enabled = Not kunci cboAnakKe.Enabled = Not kunci cboStatus.Enabled = Not kunci txtAlamat.Enabled = Not kunci txtNEM.Enabled = Not kunci dtTglDaftar.Enabled = Not kunci txtNamaSklh.Enabled = Not kunci txtAlamatSklh.Enabled = Not kunci txtAyah.Enabled = Not kunci txtIbu.Enabled = Not kunci txtAlamatOrtu.Enabled = Not kunci txtPekerjaanAyah.Enabled = Not kunci txtPekerjaanIbu.Enabled = Not kunci txtWali.Enabled = Not kunci txtAlamatWali.Enabled = Not kunci txtPekWali.Enabled = Not kunci End Sub Sub DaftarCari() On Error GoTo pesan Dim adofilter As ADODB.Recordset Set adofilter = New ADODB.Recordset Dim sqlc As String adofilter.CursorLocation = adUseClient Select Case cboCari.Text Case "No Daftar" sqlc = "SELECT * FROM calon where no_daftar like '%" & txtCari.Text & "%'" & _ "ORDER BY nama" Case "Nama" sqlc = "SELECT * FROM calon where nama like '%" & txtCari.Text & "%'" & _ "ORDER BY nama" Case "Thn Daftar" sqlc = "SELECT * FROM calon where tgl_daftar like '%" & txtCari.Text & "%'" & _ "ORDER BY nama" Case Else MsgBox "Isi dulu mau mencari berdasarkan apa !", vbExclamation, "Peringatan" cboCari.SetFocus Exit Sub End Select adofilter.Open sqlc, Conn, adOpenDynamic, adLockOptimistic If Not adofilter.EOF Then Set DataGrid1.DataSource = adofilter Set Adodc1.Recordset = adofilter Else MsgBox "Maaf, data yang anda cari tidak terdapat pada database !", vbInformation, "Informasi" txtCari.Text = "" End If Exit Sub pesan: MsgBox "Terdapat kesalahan ! " & Err.Description, vbCritical, "Peringatan" End Sub Private Sub txtCari_Change() DaftarCari End Sub Private Sub cboCari_Click() txtCari.Text = "" txtCari.SetFocus End Sub Private Sub txtNoDaftar_KeyPress(KeyAscii As Integer) HanyaAngka KeyAscii End Sub Private Sub cboAnakKe_KeyPress(KeyAscii As Integer) HanyaAngka KeyAscii End Sub Private Sub txtNEM_KeyPress(KeyAscii As Integer) HanyaAngka KeyAscii End Sub Private Sub cmdRefresh_Click() On Error GoTo referror Set DataGrid1.DataSource = Nothing Set DataGrid1.DataSource = Adodc1.Recordset.DataSource txtCari.Text = "" txtCari.SetFocus Exit Sub referror: MsgBox Err.Description End Sub Private Sub setID() On Error Resume Next Dim strID1, strID2 As String Dim a As Integer With Adodc1.Recordset If .BOF And .EOF Then 'Klo ga ada Data isi ID dengan 1 strID1 = 1 Else .MoveFirst strID1 = !no_daftar If strID1 <> (CStr(Right(Year(Now), 2)) & "001") Then 'Klo data pertama IDnya bukan HIJ001 strID1 = 1 'isi ID dengan 1 Else 'Klo ID pertama isinya HIJ001 tmabahkan 1 strID1 = Right(strID1, 3) + 1 Do .MoveNext If .EOF Then 'Klo ga ada ID yang kosong .MoveLast strID1 = !no_daftar 'Ambil ID terakhir strID1 = Right(strID1, 3) + 1 'Dan ID terakhir ditambah 1 Exit Do 'Keluar perulangan End If strID2 = !no_daftar strID2 = Right(strID2, 3) If Val(strID1) <> Val(strID2) Then Exit Do End If strID1 = strID1 + 1 Loop Until .EOF End If End If End With If Val(strID1) < 10 Then strID1 = "00" & strID1 ElseIf Val(strID1) < 100 Then strID1 = "0" & strID1 End If txtNoDaftar.Text = CStr(Right(Year(Now), 2)) & strID1 End Sub
-Untuk Selanjutnya Anda buat SubMenu Calon Siswa.
Control |
Name |
Caption |
Frame |
Frame5 |
Calon Siswa Baru |
Label |
Label8 |
No.Pendaftaran |
Label |
Label9 |
Tanggal Daftar |
Label |
Label10 |
Nama |
Label |
Label11 |
Nem |
Label |
Label12 |
Jenis_Kelamin |
Label |
Label13 |
Tempat Lahir |
Label |
Label14 |
Tanggal Lahir |
Label |
Label15 |
Agama |
Label |
Label16 |
Anak Ke- |
Label |
Label17 |
Status dalam Kel. |
Label |
Label18 |
Alamat |
Frame |
Frame6 |
Sekolah Asal |
Label |
Label19 |
Nama Sekolah |
Label |
Label20 |
Alamat |
Frame |
Frame7 |
Orang Tua |
Label |
Label21 |
Nama Ayah |
Label |
Label22 |
Nama Ibu |
Label |
Label23 |
Alamat |
Label |
Label24 |
Pekerjaan ayah |
Label |
Label25 |
Pekerjaan Ibu |
Frame |
Frame8 |
Wali |
Label |
Label26 |
Nama Wali |
Label |
Label27 |
Alamat |
Label |
Label28 |
Pekerjaan Wali |
Frame |
Frame9 |
Pencarian |
Label |
Label29 |
Berdasarkan |
Label |
Label30 |
Input |
TextBox |
TextBox |
NoDaftar |
-Untuk Selanjutnya lihat pada gambar di bawah ini.
-Masukan Source Code untuk Calon Siswa
Public baru As Boolean Private Sub cmdBatal_Click() KunciTeks True TombolAwal True KosongkanForm End Sub Private Sub cmdHapus_Click() On Error GoTo hapusErr Dim pil pil = MsgBox("Apakah anda yakin data ini akan dihapus ?", vbQuestion + vbYesNo + vbDefaultButton2, "Konfirmasi") If pil = vbYes Then Adodc1.Recordset.Delete MsgBox "Data Berhasil Dihapus !", vbInformation, "Informasi" End If Exit Sub hapusErr: MsgBox "Terdapat kesalahan ! " & Err.Description, vbCritical, "Peringatan" End Sub Private Sub cmdKeluar_Click() Unload Me End Sub Private Sub cmdSimpan_Click() On Error GoTo simpanErr If txtNoDaftar.Text = Empty Or _ txtNama.Text = Empty Or _ (optJK(0).Value = False And _ optJK(1).Value = False) Or _ txtTmptLhr.Text = Empty Or _ cboAnakKe.Text = Empty Or _ cboStatus.Text = Empty Or _ txtAlamat.Text = Empty Or _ txtNamaSklh.Text = Empty Or _ txtNEM.Text = Empty Or _ txtAlamatSklh.Text = Empty Or _ txtAyah.Text = Empty Or _ txtIbu.Text = Empty Or _ txtAlamatOrtu.Text = Empty Or _ txtPekerjaanAyah.Text = Empty Or _ txtPekerjaanIbu.Text = Empty Then MsgBox "Masih ada kolom yang kosong ! Silahkan lengkapi terlebih dahulu !", vbExclamation, "Peringatan" Else With Adodc1.Recordset If baru Then .AddNew !no_daftar = txtNoDaftar.Text !nama = txtNama.Text If optJK(0).Value = True Then !JK = "Laki-laki" ElseIf optJK(1).Value = True Then !JK = "Perempuan" End If !tmpt_lhr = txtTmptLhr.Text !tgl_lhr = Format(dtTglLhr.Value, "d/mm/yyyy") !agama = cboAgama.Text !anak_ke = cboAnakKe.Text !Status = cboStatus.Text !alamat = txtAlamat.Text !nem = txtNEM.Text !tgl_daftar = Format(dtTglDaftar.Value, "d/mm/yyyy") !sekolah_asal = txtNamaSklh.Text !alamat_sekolah = txtAlamatSklh.Text !ayah = txtAyah.Text !ibu = txtIbu.Text !alamat_ortu = txtAlamatOrtu.Text !pek_ayah = txtPekerjaanAyah.Text !pek_ibu = txtPekerjaanIbu.Text !wali = txtWali.Text !alamat_wali = txtAlamatWali.Text !pek_wali = txtPekWali.Text .Update MsgBox "Data berhasil disimpan !", vbInformation, "Informasi" KunciTeks True TombolAwal True KosongkanForm End With End If Exit Sub simpanErr: MsgBox "Terdapat kesalahan ! " & Err.Description, vbCritical, "Peringatan" End Sub Private Sub cmdTambah_Click() baru = True KunciTeks False TombolAwal False txtNoDaftar.SetFocus cboAgama.Text = "Islam" 'txtNoDaftar.Text = GetAutoNumber("", "", 3) 'txtNoDaftar.Text = GetAutoNumber(Right(CStr(Year(Now)), 2), , 3) setID Adodc1.ConnectionString = Conn.ConnectionString Adodc1.RecordSource = "select * from calon order by no_daftar" Adodc1.Refresh Set DataGrid1.DataSource = Adodc1 End Sub Sub TombolAwal(kunci As Boolean) cmdTambah.Enabled = kunci cmdSimpan.Enabled = Not kunci cmdBatal.Enabled = Not kunci cmdUbah.Enabled = kunci cmdHapus.Enabled = kunci cmdKeluar.Enabled = kunci cmdRefresh.Enabled = kunci End Sub Private Sub cmdUbah_Click() On Error GoTo ubahErr KunciTeks False TombolAwal False baru = False With Adodc1.Recordset txtNoDaftar.Text = !no_daftar txtNama.Text = !nama If !JK = "Laki-laki" Then optJK(0).Value = True ElseIf !JK = "Perempuan" Then optJK(1).Value = True End If txtTmptLhr.Text = !tmpt_lhr dtTglLhr.Value = !tgl_lhr cboAgama.Text = !agama cboAnakKe.Text = !anak_ke cboStatus.Text = !Status txtAlamat.Text = !alamat txtNEM.Text = !nem dtTglDaftar.Value = !tgl_daftar txtNamaSklh.Text = !sekolah_asal txtAlamatSklh.Text = !alamat_sekolah txtAyah.Text = !ayah txtIbu.Text = !ibu txtAlamatOrtu.Text = !alamat_ortu txtPekerjaanAyah.Text = !pek_ayah txtPekerjaanIbu.Text = !pek_ibu txtWali.Text = !wali txtAlamatWali.Text = !alamat_wali txtPekWali.Text = !pek_wali End With txtNoDaftar.SetFocus Exit Sub ubahErr: MsgBox "Terdapat kesalahan ! " & Err.Description, vbCritical, "Peringatan" End Sub Private Sub Form_Load() koneksi KunciTeks True TombolAwal True Adodc1.ConnectionString = Conn.ConnectionString Adodc1.RecordSource = "select * from calon order by no_daftar" Adodc1.Refresh Set DataGrid1.DataSource = Adodc1 dtTglLhr.Value = Now dtTglDaftar.Value = Now End Sub Private Sub Form_Activate() Dim i As Integer For i = 0 To 20 DataGrid1.Columns(i).Locked = True Next i End Sub Sub KosongkanForm() txtNoDaftar.Text = Empty txtNama.Text = Empty optJK(0).Value = False optJK(1).Value = False txtTmptLhr.Text = Empty dtTglLhr.Value = Now cboAgama.Text = Empty cboAnakKe.Text = Empty cboStatus.Text = Empty txtAlamat.Text = Empty txtNEM.Text = Empty dtTglDaftar.Value = Now txtNamaSklh.Text = Empty txtAlamatSklh.Text = Empty txtAyah.Text = Empty txtIbu.Text = Empty txtAlamatOrtu.Text = Empty txtPekerjaanAyah.Text = Empty txtPekerjaanIbu.Text = Empty txtWali.Text = Empty txtAlamatWali.Text = Empty txtPekWali.Text = Empty End Sub Sub KunciTeks(kunci As Boolean) txtNoDaftar.Enabled = Not kunci txtNama.Enabled = Not kunci optJK(0).Enabled = Not kunci optJK(1).Enabled = Not kunci txtTmptLhr.Enabled = Not kunci dtTglLhr.Enabled = Not kunci cboAgama.Enabled = Not kunci cboAnakKe.Enabled = Not kunci cboStatus.Enabled = Not kunci txtAlamat.Enabled = Not kunci txtNEM.Enabled = Not kunci dtTglDaftar.Enabled = Not kunci txtNamaSklh.Enabled = Not kunci txtAlamatSklh.Enabled = Not kunci txtAyah.Enabled = Not kunci txtIbu.Enabled = Not kunci txtAlamatOrtu.Enabled = Not kunci txtPekerjaanAyah.Enabled = Not kunci txtPekerjaanIbu.Enabled = Not kunci txtWali.Enabled = Not kunci txtAlamatWali.Enabled = Not kunci txtPekWali.Enabled = Not kunci End Sub Sub DaftarCari() On Error GoTo pesan Dim adofilter As ADODB.Recordset Set adofilter = New ADODB.Recordset Dim sqlc As String adofilter.CursorLocation = adUseClient Select Case cboCari.Text Case "No Daftar" sqlc = "SELECT * FROM calon where no_daftar like '%" & txtCari.Text & "%'" & _ "ORDER BY nama" Case "Nama" sqlc = "SELECT * FROM calon where nama like '%" & txtCari.Text & "%'" & _ "ORDER BY nama" Case "Thn Daftar" sqlc = "SELECT * FROM calon where tgl_daftar like '%" & txtCari.Text & "%'" & _ "ORDER BY nama" Case Else MsgBox "Isi dulu mau mencari berdasarkan apa !", vbExclamation, "Peringatan" cboCari.SetFocus Exit Sub End Select adofilter.Open sqlc, Conn, adOpenDynamic, adLockOptimistic If Not adofilter.EOF Then Set DataGrid1.DataSource = adofilter Set Adodc1.Recordset = adofilter Else MsgBox "Maaf, data yang anda cari tidak terdapat pada database !", vbInformation, "Informasi" txtCari.Text = "" End If Exit Sub pesan: MsgBox "Terdapat kesalahan ! " & Err.Description, vbCritical, "Peringatan" End Sub Private Sub txtCari_Change() DaftarCari End Sub Private Sub cboCari_Click() txtCari.Text = "" txtCari.SetFocus End Sub Private Sub txtNoDaftar_KeyPress(KeyAscii As Integer) HanyaAngka KeyAscii End Sub Private Sub cboAnakKe_KeyPress(KeyAscii As Integer) HanyaAngka KeyAscii End Sub Private Sub txtNEM_KeyPress(KeyAscii As Integer) HanyaAngka KeyAscii End Sub Private Sub cmdRefresh_Click() On Error GoTo referror Set DataGrid1.DataSource = Nothing Set DataGrid1.DataSource = Adodc1.Recordset.DataSource txtCari.Text = "" txtCari.SetFocus Exit Sub referror: MsgBox Err.Description End Sub Private Sub setID() On Error Resume Next Dim strID1, strID2 As String Dim a As Integer With Adodc1.Recordset If .BOF And .EOF Then 'Klo ga ada Data isi ID dengan 1 strID1 = 1 Else .MoveFirst strID1 = !no_daftar If strID1 <> (CStr(Right(Year(Now), 2)) & "001") Then 'Klo data pertama IDnya bukan HIJ001 strID1 = 1 'isi ID dengan 1 Else 'Klo ID pertama isinya HIJ001 tmabahkan 1 strID1 = Right(strID1, 3) + 1 Do .MoveNext If .EOF Then 'Klo ga ada ID yang kosong .MoveLast strID1 = !no_daftar 'Ambil ID terakhir strID1 = Right(strID1, 3) + 1 'Dan ID terakhir ditambah 1 Exit Do 'Keluar perulangan End If strID2 = !no_daftar strID2 = Right(strID2, 3) If Val(strID1) <> Val(strID2) Then Exit Do End If strID1 = strID1 + 1 Loop Until .EOF End If End If End With If Val(strID1) < 10 Then strID1 = "00" & strID1 ElseIf Val(strID1) < 100 Then strID1 = "0" & strID1 End If txtNoDaftar.Text = CStr(Right(Year(Now), 2)) & strID1 EndSub
-Untuk Selanjutnya Kita Buat SubMenu Pengisian NIS.
Control |
Name |
Caption |
Label |
Label31 |
Tahun Ajaran |
ComboBox |
CboTahun |
- |
CommandButon |
CmdLoad |
&Load Calon Siswa |
CommandButon |
CmdIsi |
&Isi NIS |
CommandButon |
Command10 |
&Keluar |
DataGrid1 |
DataGrid1 |
- |
Adodc1 |
Adodc1 |
Adodc1 |
Design Form sesuai contoh dibawah ini :
-Jika Sudah Selesai,Masukan Source Code dibawah ini :
Private Sub cmdIsi_Click() Dim i As Integer i = 1 With Adodc1.Recordset .MoveFirst While Not .EOF DataGrid1.Columns(2).Text = CStr(Year(Now)) & VBA.Format$(CStr(i), VBA.String$(3, "0")) i = i + 1 .MoveNext Wend End With End Sub Private Sub cmdLoad_Click() On Error Resume Next Adodc1.ConnectionString = Conn.ConnectionString Adodc1.RecordSource = "select no_daftar,nama,NIS from calon where year(tgl_daftar)='" & cboThn.Text & "' order by nama" Adodc1.Refresh Set DataGrid1.DataSource = Adodc1 End Sub Private Sub Command4_Click() Unload Me End Sub Private Sub Form_Load() koneksi cboThn.AddItem "2010" cboThn.AddItem "2011" cboThn.AddItem "2012" cboThn.AddItem "2013" cboThn.AddItem "2014" cboThn.AddItem "2015" cboThn.AddItem "2016" cboThn.AddItem "2017" cboThn.AddItem "2018" End Sub
-Setelah selesai buat design tampilan seperti berikut ini.
-Kemudian Masukan Source Code Berikut.
Public baru As Boolean Dim rsDaftar As ADODB.Recordset Private Sub cboDaftar_Click() Set rsDaftar = New ADODB.Recordset rsDaftar.Open "select * from calon where no_daftar='" & cboDaftar.Text & "'", Conn With rsDaftar txtNIS.Text = !NIS txtNama.Text = !nama If !JK = "Laki-laki" Then optJK(0).Value = True ElseIf !JK = "Perempuan" Then optJK(1).Value = True End If txtTmptLhr.Text = !tmpt_lhr dtTglLhr.Value = !tgl_lhr cboAgama.Text = !agama cboAnakKe.Text = !anak_ke cboStatus.Text = !Status txtAlamat.Text = !alamat txtNEM.Text = !nem txtNamaSklh.Text = !sekolah_asal txtAlamatSklh.Text = !alamat_sekolah txtAyah.Text = !ayah txtIbu.Text = !ibu txtAlamatOrtu.Text = !alamat_ortu txtPekerjaanAyah.Text = !pek_ayah txtPekerjaanIbu.Text = !pek_ibu txtWali.Text = !wali txtAlamatWali.Text = !alamat_wali txtPekWali.Text = !pek_wali End With txtNIS.SetFocus End Sub Private Sub cboThnAjaran_KeyPress(KeyAscii As Integer) HanyaAngka KeyAscii End Sub Private Sub cmdBatal_Click() KunciTeks True TombolAwal True KosongkanForm End Sub Private Sub cmdHapus_Click() On Error GoTo hapusErr Dim pil pil = MsgBox("Apakah anda yakin data ini akan dihapus ?", vbQuestion + vbYesNo + vbDefaultButton2, "Konfirmasi") If pil = vbYes Then Adodc1.Recordset.Delete MsgBox "Data Berhasil Dihapus !", vbInformation, "Informasi" End If Exit Sub hapusErr: MsgBox "Terdapat kesalahan ! " & Err.Description, vbCritical, "Peringatan" End Sub Private Sub cmdKeluar_Click() Unload Me End Sub Private Sub cmdSimpan_Click() On Error GoTo simpanErr If txtNIS.Text = Empty Or _ txtNama.Text = Empty Or _ (optJK(0).Value = False And _ optJK(1).Value = False) Or _ txtTmptLhr.Text = Empty Or _ cboAgama.Text = Empty Or _ cboAnakKe.Text = Empty Or _ cboStatus.Text = Empty Or _ txtAlamat.Text = Empty Or _ cboKelas.Text = Empty Or _ txtNamaSklh.Text = Empty Or _ txtNEM.Text = Empty Or _ cboThnAjaran.Text = Empty Or _ txtAlamatSklh.Text = Empty Or _ txtAyah.Text = Empty Or _ txtIbu.Text = Empty Or _ txtAlamatOrtu.Text = Empty Or _ txtPekerjaanAyah.Text = Empty Or _ txtPekerjaanIbu.Text = Empty Then MsgBox "Masih ada kolom yang kosong ! Silahkan lengkapi terlebih dahulu !", vbExclamation, "Peringatan" Else Dim rscek As ADODB.Recordset Set rscek = New ADODB.Recordset rscek.Open "select * from siswa where no_daftar='" & cboDaftar.Text & "'", Conn If Not rscek.EOF And baru Then MsgBox "Data siswa dengan No Daftar " & cboDaftar.Text & " sudah ada !", vbExclamation, "Peringatan" cboDaftar.SetFocus Else With Adodc1.Recordset If baru Then .AddNew !NIS = txtNIS.Text !nama = txtNama.Text If optJK(0).Value = True Then !JK = "Laki-laki" ElseIf optJK(1).Value = True Then !JK = "Perempuan" End If !tmpt_lhr = txtTmptLhr.Text !tgl_lhr = dtTglLhr.Value !agama = cboAgama.Text !anak_ke = cboAnakKe.Text !Status = cboStatus.Text !alamat = txtAlamat.Text !kelas = cboKelas.Text !nem = txtNEM.Text !tgl_diterima = dtTgl.Value !thn_ajaran = cboThnAjaran.Text !sekolah_asal = txtNamaSklh.Text !alamat_sekolah = txtAlamatSklh.Text !ayah = txtAyah.Text !ibu = txtIbu.Text !alamat_ortu = txtAlamatOrtu.Text !pek_ayah = txtPekerjaanAyah.Text !pek_ibu = txtPekerjaanIbu.Text !wali = txtWali.Text !alamat_wali = txtAlamatWali.Text !pek_wali = txtPekWali.Text !no_daftar = cboDaftar.Text .Update MsgBox "Data berhasil disimpan !", vbInformation, "Informasi" KunciTeks True TombolAwal True KosongkanForm End With End If End If Exit Sub simpanErr: MsgBox "Terdapat kesalahan ! " & Err.Description, vbCritical, "Peringatan" End Sub Private Sub cmdTambah_Click() baru = True KunciTeks False TombolAwal False txtNIS.SetFocus End Sub Sub TombolAwal(kunci As Boolean) cmdTambah.Enabled = kunci cmdSimpan.Enabled = Not kunci cmdBatal.Enabled = Not kunci cmdUbah.Enabled = kunci cmdHapus.Enabled = kunci cmdKeluar.Enabled = kunci cmdRefresh.Enabled = kunci End Sub Private Sub cmdUbah_Click() On Error GoTo ubahErr KunciTeks False TombolAwal False baru = False With Adodc1.Recordset txtNIS.Text = !NIS txtNama.Text = !nama If !JK = "Laki-laki" Then optJK(0).Value = True ElseIf !JK = "Perempuan" Then optJK(1).Value = True End If txtTmptLhr.Text = !tmpt_lhr dtTglLhr.Value = !tgl_lhr cboAgama.Text = !agama cboAnakKe.Text = !anak_ke cboStatus.Text = !Status txtAlamat.Text = !alamat cboKelas.Text = !kelas txtNEM.Text = !nem cboThnAjaran.Text = !thn_ajaran dtTgl.Value = !tgl_diterima txtNamaSklh.Text = !sekolah_asal txtAlamatSklh.Text = !alamat_sekolah txtAyah.Text = !ayah txtIbu.Text = !ibu txtAlamatOrtu.Text = !alamat_ortu txtPekerjaanAyah.Text = !pek_ayah txtPekerjaanIbu.Text = !pek_ibu txtWali.Text = !wali txtAlamatWali.Text = !alamat_wali txtPekWali.Text = !pek_wali cboDaftar.Text = !no_daftar End With txtNIS.SetFocus Exit Sub ubahErr: MsgBox "Terdapat kesalahan ! " & Err.Description, vbCritical, "Peringatan" End Sub Private Sub Form_Load() koneksi KunciTeks True TombolAwal True Adodc1.ConnectionString = Conn.ConnectionString Adodc1.RecordSource = "select * from siswa" Adodc1.Refresh Set DataGrid1.DataSource = Adodc1 cboKelas.Clear cboKelas.AddItem "10-1" cboKelas.AddItem "10-2" cboKelas.AddItem "10-3" cboKelas.AddItem "10-4" cboKelas.AddItem "10-5" cboKelas.AddItem "10-6" cboKelas.AddItem "10-7" cboKelas.AddItem "10-8" cboKelas.AddItem "10-9" cboThnAjaran.Clear Dim t As Integer t = CInt(Year(Now)) t = t - 1 For i = 1 To 10 cboThnAjaran.AddItem CStr(t) t = t + 1 Next i dtTgl.Value = Now Set rsDaftar = New ADODB.Recordset rsDaftar.Open "select * from calon", Conn cboDaftar.Clear While Not rsDaftar.EOF cboDaftar.AddItem rsDaftar!no_daftar rsDaftar.MoveNext Wend End Sub Private Sub Form_Activate() Dim i As Integer For i = 0 To 21 DataGrid1.Columns(i).Locked = True Next i End Sub Sub KosongkanForm() txtNIS.Text = Empty cboDaftar.Text = Empty txtNama.Text = Empty optJK(0).Value = False optJK(1).Value = False txtTmptLhr.Text = Empty dtTglLhr.Value = Now cboAgama.Text = Empty cboAnakKe.Text = Empty cboStatus.Text = Empty txtAlamat.Text = Empty cboKelas.Text = Empty txtNEM.Text = Empty cboThnAjaran.Text = Empty dtTgl.Value = Now txtNamaSklh.Text = Empty txtAlamatSklh.Text = Empty txtAyah.Text = Empty txtIbu.Text = Empty txtAlamatOrtu.Text = Empty txtPekerjaanAyah.Text = Empty txtPekerjaanIbu.Text = Empty txtWali.Text = Empty txtAlamatWali.Text = Empty txtPekWali.Text = Empty End Sub Sub KunciTeks(kunci As Boolean) txtNIS.Enabled = Not kunci cboDaftar.Enabled = Not kunci txtNama.Enabled = Not kunci optJK(0).Enabled = Not kunci optJK(1).Enabled = Not kunci txtTmptLhr.Enabled = Not kunci dtTglLhr.Enabled = Not kunci cboAgama.Enabled = Not kunci cboAnakKe.Enabled = Not kunci cboStatus.Enabled = Not kunci txtAlamat.Enabled = Not kunci cboKelas.Enabled = Not kunci txtNEM.Enabled = Not kunci cboThnAjaran.Enabled = Not kunci dtTgl.Enabled = Not kunci txtNamaSklh.Enabled = Not kunci txtAlamatSklh.Enabled = Not kunci txtAyah.Enabled = Not kunci txtIbu.Enabled = Not kunci txtAlamatOrtu.Enabled = Not kunci txtPekerjaanAyah.Enabled = Not kunci txtPekerjaanIbu.Enabled = Not kunci txtWali.Enabled = Not kunci txtAlamatWali.Enabled = Not kunci txtPekWali.Enabled = Not kunci End Sub Sub DaftarCari() On Error GoTo pesan Dim adofilter As ADODB.Recordset Set adofilter = New ADODB.Recordset Dim sqlc As String adofilter.CursorLocation = adUseClient Select Case cboCari.Text Case "NIS" sqlc = "SELECT * FROM siswa where NIS like '%" & txtCari.Text & "%'" & _ "ORDER BY nama" Case "Nama" sqlc = "SELECT * FROM siswa where nama like '%" & txtCari.Text & "%'" & _ "ORDER BY nama" Case Else MsgBox "Isi dulu mau mencari berdasarkan apa !", vbExclamation, "Peringatan" cboCari.SetFocus Exit Sub End Select adofilter.Open sqlc, Conn, adOpenDynamic, adLockOptimistic If Not adofilter.EOF Then Set DataGrid1.DataSource = adofilter Set Adodc1.Recordset = adofilter Else MsgBox "Maaf, data yang anda cari tidak terdapat pada database !", vbInformation, "Informasi" txtCari.Text = "" End If Exit Sub pesan: MsgBox "Terdapat kesalahan ! " & Err.Description, vbCritical, "Peringatan" End Sub Private Sub txtCari_Change() DaftarCari End Sub Private Sub cboCari_Click() txtCari.Text = "" txtCari.SetFocus End Sub Private Sub txtNEM_KeyPress(KeyAscii As Integer) HanyaAngka KeyAscii End Sub Private Sub txtNIS_KeyPress(KeyAscii As Integer) HanyaAngka KeyAscii End Sub Private Sub cboAnakKe_KeyPress(KeyAscii As Integer) HanyaAngka KeyAscii End Sub Private Sub cmdRefresh_Click() On Error GoTo referror Set DataGrid1.DataSource = Nothing Set DataGrid1.DataSource = Adodc1.Recordset.DataSource txtCari.Text = "" txtCari.SetFocus Exit Sub referror: MsgBox Err.Description End Sub
Mungkin Demikian Penjelasan mengenai Aplikasi PSB Part2,kita nantikan penejelasan tutorial mengenai pembuatan menuLaporan dan about di Aplikas Psb Part 3.semoga bermanfaat dan dapat dipelajari dengan baik.
Wassalamualaikum Wr.Wb