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.

Tutorial pembuatan Aplikasi penerimaan siswa baru (PSB) Sederhana Part 2

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

#

About Author

hendra

Seorang lulusan teknik informatika yang gemar menulis Coding yang tanpa lelah terus belajar untuk dapat menaklukan bahasa pemrograman.


Comment & Discussions

    Please LOGIN before if you want to give the comment.