Coding ini aku bagikan sebagai materi pembelajaran lebih lanjut perihal script VBA atau pemrograman Visual Basic. Tampilan untuk Form Penerimaan Peserta Didik Baru (PPDB) atau lebih dikenal PSB (Penerimaan Siswa Baru) sangat sederhana namun ini merupakan desain yang diubahsuaikan dengan Aplikasi DAPODIK terbaru untuk tingkat SMA/SMK sehingga saat upload pendaftar siswa gres dapat eksklusif saja melalui Excel.Masih ingat Aplikasi PPDB yang pernah aku posting dan bagikan secara gratis di blog excel ini? Jika ya, aku akan coba menciptakan dan membagikan coding atau script PPDB untuk tahun 2016/2017.
Form Pendaftaran siswa gres ini merupakan pengembangan dari versi aplikasi PPDB sebelumnya, mudah-mudahan ke depan nanti dapat bermanfaat baik untuk dipakai maupun dalam hal pembelajaran pembuatan aplikasi berbasis Exel ini.
Simak :Berikut tampilan Form Pendaftaran PPDB Tahun 2016/2017
Aplikasi PPDB Terbaru
Baca : Aplikasi PPDB Berbasis Excel
Berikut Coding script VBA PPDB 2016/2017
Script Tombol Tambah Data
Private Sub TombolTambah_Click()
Dim iRow As Long
Dim Ws As Worksheet
Set Ws = Worksheets("DatabaseUmum")
Dim Path As String
iRow = Ws.Cells(Rows.Count, 3) _
.End(xlUp).Offset(1, 0).Row
If WorksheetFunction.CountIf(Ws.Range("A2", Ws.Cells(iRow - 1, 3)), Me.TextBox1.Value) > 0 Then
MsgBox "Nomor Pendaftar sudah ada", vbInformation, "Info"
Call KosongkanFormPendaftar
TextBox1.Value = "REG-" & Worksheets("TabelBantu").Cells(2, 6).Value
End If
If Trim(Me.TextBox1.Value) = "" Then
Me.TextBox1.SetFocus
MsgBox "Nomor Pendaftar harus diisi"
Exit Sub
End If
If Trim(Me.TextBox2.Value) = "" Then
Me.TextBox2.SetFocus
MsgBox "Silakan tuliskan nama pendaftar"
Exit Sub
End If
If Trim(Me.TextBox3.Value) = "" Then
Me.TextBox3.SetFocus
MsgBox "NIK dilarang kosong"
Exit Sub
End If
If Trim(Me.TextBox4.Value) = "" Then
Me.TextBox4.SetFocus
MsgBox "Tempat lahir dilarang kosong"
Exit Sub
End If
If Trim(Me.TextBox5.Value) = "" Then
Me.TextBox5.SetFocus
MsgBox "Tanggal Lahir harus diisi"
Exit Sub
End If
If Trim(Me.ComboBox1.Value) = "" Then
Me.ComboBox1.SetFocus
MsgBox "Jenis Kelamin harus diisi"
Exit Sub
End If
If Trim(Me.ComboBox2.Value) = "" Then
Me.ComboBox2.SetFocus
MsgBox "Jenis registrasi dilarang kosong"
Exit Sub
End If
Ws.Cells(iRow, 1).Value = Me.TextBox1.Value
Ws.Cells(iRow, 2).Value = Me.TextBox2.Value
Ws.Cells(iRow, 3).Value = Me.ComboBox1.Value
If ComboBox1.Value = "Laki-Laki" Then
Ws.Cells(iRow, 3).Value = "L"
Else
Ws.Cells(iRow, 3).Value = "P"
End If
Ws.Cells(iRow, 4).Value = Me.TextBox3.Value
Ws.Cells(iRow, 5).Value = Me.TextBox4.Value
Ws.Cells(iRow, 6).Value = Me.TextBox5.Value
Ws.Cells(iRow, 7).Value = Me.TextBox6.Value
Ws.Cells(iRow, 8).Value = Me.ComboBox2.Value
Ws.Cells(iRow, 9).Value = Me.ComboBox3.Value
Ws.Cells(iRow, 10).Value = Me.N1.Value
Ws.Cells(iRow, 11).Value = Me.N2.Value
Ws.Cells(iRow, 12).Value = Me.N3.Value
Ws.Cells(iRow, 13).Value = Me.N4.Value
Ws.Cells(iRow, 14).Value = Me.NJumlah.Value
Call BerkasPersyaratan
If ComboBox2.Value = "Siswa Baru" Then
Ws.Cells(iRow, 8).Value = "1"
Else
Ws.Cells(iRow, 8).Value = "2"
End If
Call KosongkanFormPendaftar
TextBox2.SetFocus
TextBox1.Value = "REG-" & Worksheets("TabelBantu").Cells(2, 6).Value
Call ListPendaftar
End Sub
Script Edit Data Pendaftar
Private Sub TombolEdit_Click()
Dim iRow As Long
Dim Ws As Worksheet
Set Ws = Worksheets("DatabaseUmum")
iRow = Ws.Cells(Rows.Count, 3) _
.End(xlUp).Offset(1, 0).Row
If Me.TextBox1.Value = "" Then
MsgBox "Maaf, mau edit data siapa? Silakan masukan dulu NIS nya", vbInformation, "Info"
Me.TextBox2.SetFocus
Exit Sub
End If
If TextBox1.Value = "" Then
MsgBox "TIdak ada yang harus diedit", vbInformation, "Info"
Else
Nomor = Trim(Me.TextBox1.Value)
With Sheets("DatabaseUmum")
Baris = .Columns("A").Find(Nomor).Row
.Range("A" & Baris).Value = Me.TextBox1.Value
.Range("B" & Baris).Value = Me.TextBox2.Value
.Range("C" & Baris).Value = Me.ComboBox1.Value
.Range("D" & Baris).Value = Me.TextBox3.Value
.Range("E" & Baris).Value = Me.TextBox4.Value
.Range("F" & Baris).Value = Me.TextBox5.Value
.Range("G" & Baris).Value = Me.TextBox6.Value
.Range("H" & Baris).Value = Me.ComboBox2.Value
.Range("I" & Baris).Value = Me.ComboBox3.Value
.Range("J" & Baris).Value = Me.N1.Value
.Range("K" & Baris).Value = Me.N2.Value
.Range("L" & Baris).Value = Me.N3.Value
.Range("M" & Baris).Value = Me.N4.Value
.Range("N" & Baris).Value = Me.NJumlah.Value
If Berkas1.Value = True Then
.Range("O" & Baris).Value = "V"
End If
If Berkas2.Value = True Then
.Range("P" & Baris).Value = "V"
End If
If Berkas3.Value = True Then
.Range("Q" & Baris).Value = "V"
End If
If Berkas4.Value = True Then
.Range("R" & Baris).Value = "V"
End If
If Berkas5.Value = True Then
.Range("S" & Baris).Value = "V"
End If
If Berkas6.Value = True Then
.Range("T" & Baris).Value = "V"
End If
If Berkas7.Value = True Then
.Range("U" & Baris).Value = "V"
End If
If ComboBox1.Value = "Laki-Laki" Then
.Range("C" & Baris).Value = "L"
Else
.Range("C" & Baris).Value = "P"
End If
If ComboBox2.Value = "Siswa Baru" Then
.Range("H" & Baris).Value = "1"
Else
.Range("H" & Baris).Value = "2"
End If
End With
MsgBox "Data berhasil diupdate ", vbInformation, "Info"
Call KosongkanFormPendaftar
TextBox2.SetFocus
TextBox1.Value = "REG-" & Worksheets("TabelBantu").Cells(2, 6).Value
CheckBox8.Value = True
End If
End Sub
Coding Hapus Data Pendaftar PPDB
Private Sub TombolHapus_Click()
On Error GoTo TerjadiKesalahan
Dim pesan As String
Dim Ws As Worksheet
Set Ws = Worksheets("DatabaseUmum")
Dim shtSeason As Worksheet
Dim c As Range
If TextBox1.Value = "" Then
MsgBox "Silakan Cari No. Registrasi Terlbih Dahulu", vbInformation, "Info"
TextBox2.SetFocus
Else
pesan = TextBox1.Text + " - Akan dihapus dari database, Anda yakin? "
If MsgBox(pesan, vbQuestion + vbYesNo, _
"Konfirmasi Penghapusan") = vbYes Then
Set shtSeason = Sheets("DatabaseUmum")
Set c = shtSeason.Columns(1).Find(TextBox1.Text)
c.Resize(, 21).Delete Shift:=xlUp
MsgBox "Data Berhasil Dihapus", vbOKOnly
Call KosongkanFormPendaftar
TextBox1.Value = "REG-" & Worksheets("TabelBantu").Cells(2, 6).Value
Else
Exit Sub
End If
End If
TerjadiKesalahan:
TextBox2.Value = ""
End Sub
Coding VBA Pencarian Data Pendaftar PPDB
Private Sub TombolCariNama_Click()Coding Pencarian Data Melalui Nomor Registrasi Pendaftar
Dim Cari As Range
Dim Ws As Worksheet
Dim Nama As String
Set Ws = Worksheets("DatabaseUmum")
Nama = Me.TulisCariNama.Text
Set Cari = Ws.Range("B2:C1000").Find(What:=TulisCariNama)
If Not Cari Is Nothing Then
TulisCariNama.Text = ""
TombolCariNama.SetFocus
TextBox1.Text = Ws.Cells(Cari.Row, 1)
ComboBox1.Text = Ws.Cells(Cari.Row, 3)
TextBox2.Text = Ws.Cells(Cari.Row, 2)
TextBox3.Text = Ws.Cells(Cari.Row, 4)
TextBox4.Text = Ws.Cells(Cari.Row, 5)
TextBox5.Text = Ws.Cells(Cari.Row, 6)
TextBox6.Text = Ws.Cells(Cari.Row, 7)
ComboBox2.Text = Ws.Cells(Cari.Row, 8)
ComboBox3.Text = Ws.Cells(Cari.Row, 9)
Else
MsgBox "Maaf Nama tidak ditemukan", 48, "Peringatan..."
TulisCariNama.Text = ""
TulisCariNama.SetFocus
End If
End Sub
Private Sub TextBox1_Change()Coding Checkbox Penguncian Nomor Registrasi
If TextBox1.Value = "" Then
TextBox1.Value = "REG-" & Worksheets("TabelBantu").Cells(2, 6).Value
Else
Call CariPendaftar
End If
End Sub
Private Sub CheckBox8_Click()Coding Penjumlahan Nilai UN SMP/MTS
If CheckBox8.Value = True Then
TextBox1.Enabled = False
Else
TextBox1.Enabled = True
End If
End Sub
Sub JumlahkanNilai()Coding Perubahan saat Perubahan Nilai UN untuk setiap Mata Pelajaran UN
If N1.Value = "" Then Exit Sub
If N2.Value = "" Then Exit Sub
If N3.Value = "" Then Exit Sub
If N4.Value = "" Then Exit Sub
NJumlah.Value = CDbl(N1.Value) + CDbl(N2.Value) + CDbl(N3.Value) + CDbl(N4.Value)
End Sub
Private Sub N1_Change()
Call JumlahkanNilai
End Sub
Private Sub N2_Change()
Call JumlahkanNilai
End Sub
Private Sub N3_Change()
Call JumlahkanNilai
End Sub
Private Sub N4_Change()
Call JumlahkanNilai
End Sub
Coding Memaksa Agar Tulisan Capital
Private Sub TextBox2_Change()
TextBox2.Text = UCase(TextBox2.Text)
End Sub
Private Sub TextBox4_Change()
TextBox4.Text = UCase(TextBox4.Text)
End Sub
Private Sub TextBox6_Change()
TextBox6.Text = UCase(TextBox6.Text)
End Sub
Coding / Script Untuk Pengisian Persyaratan Dokumen PPDB
Sub BerkasPersyaratan()Coding untuk ListPendaftaran
Dim iRow As Long
Dim Ws As Worksheet
Set Ws = Worksheets("DatabaseUmum")
Dim Path As String
iRow = Ws.Cells(Rows.Count, 3) _
.End(xlUp).Offset(0, 0).Row
If Berkas1.Value = True Then
Ws.Cells(iRow, 15).Value = "V"
End If
If Berkas2.Value = True Then
Ws.Cells(iRow, 16).Value = "V"
End If
If Berkas3.Value = True Then
Ws.Cells(iRow, 17).Value = "V"
End If
If Berkas4.Value = True Then
Ws.Cells(iRow, 18).Value = "V"
End If
If Berkas5.Value = True Then
Ws.Cells(iRow, 19).Value = "V"
End If
If Berkas6.Value = True Then
Ws.Cells(iRow, 20).Value = "V"
End If
If Berkas7.Value = True Then
Ws.Cells(iRow, 21).Value = "V"
End If
End Sub
Private Sub ListPendaftar()Coding VBA untuk UserForm Initialize
With UserForm2
.ListBox1.RowSource = "DatabasePendaftar" ' data diambil dari NameRange
.ListBox1.ColumnWidths = "50,150,35,100,90,70,120,55,120,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0"
End With
End Sub
Private Sub UserForm_Initialize()Coding Untuk Pewarnaan
Call KosongkanFormPendaftar
TextBox2.SetFocus
With ComboBox1
.AddItem "Laki-Laki"
.AddItem "Perempuan"
.AutoWordSelect = True
End With
With ComboBox2
.AddItem "Siswa Baru"
.AddItem "Siswa Pindahan"
.AutoWordSelect = True
End With
If TextBox1.Value = "" Then
TextBox1.Value = "REG-" & Worksheets("TabelBantu").Cells(2, 6).Value
Else
Call CariPendaftar
End If
Call ListPendaftar
CheckBox8.Value = True
End Sub
Private Sub TulisCariNama_LostFocus()Modul Pencarian Data Pendaftar
Call DefaultWarna
End Sub
Private Sub TulisCariNama_enter()
Call RubahWarna
End Sub
Private Sub TulisCariNama_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call DefaultWarna
End Sub
Sub RubahWarna()
TextBox1.BackColor = &H80000003
TextBox2.BackColor = &H80000003
ComboBox1.BackColor = &H80000003
TextBox3.BackColor = &H80000003
TextBox4.BackColor = &H80000003
TextBox5.BackColor = &H80000003
TextBox6.BackColor = &H80000003
ComboBox2.BackColor = &H80000003
ComboBox3.BackColor = &H80000003
N1.BackColor = &H80000003
N2.BackColor = &H80000003
N3.BackColor = &H80000003
N4.BackColor = &H80000003
NJumlah.BackColor = &H80000003
End Sub
Sub DefaultWarna()
TextBox1.BackColor = &H80000005
TextBox2.BackColor = &H80000005
ComboBox1.BackColor = &H80000005
TextBox3.BackColor = &H80000005
TextBox4.BackColor = &H80000005
TextBox5.BackColor = &H80000005
TextBox6.BackColor = &H80000005
ComboBox2.BackColor = &H80000005
ComboBox3.BackColor = &H80000005
N1.BackColor = &H80000005
N2.BackColor = &H80000005
N3.BackColor = &H80000005
N4.BackColor = &H80000005
NJumlah.BackColor = &H80000005
End Sub
Sub CariPendaftar()Modul Untuk Mengosongkan Data Pendaftar
Dim TidakDitemukan As Range
Set TidakDitemukan = Sheets("DatabaseUmum").Cells.Find(What:=TextBox1, LookIn:=xlFormulas, Lookat:=xlWhole)
Dim Cekdulu As String
Set NamaSheet = Sheets("DatabaseUmum")
On Error Resume Next
Set NamaRange = NamaSheet.Range("A2:A1000")
With UserForm2
If .TextBox1.Value = "" Then
Call PendaftarTidakDitemukan
End If
Set c = NamaRange.Find(.TextBox1.Value, LookIn:=xlValues, _
MatchCase:=False)
.TextBox1.Value = c.Offset(0, 0).Value
.TextBox2.Value = c.Offset(0, 1).Value
.ComboBox1.Value = c.Offset(0, 2).Value
.TextBox3.Value = c.Offset(0, 3).Value
.TextBox4.Value = c.Offset(0, 4).Value
.TextBox5.Value = c.Offset(0, 5).Value
.TextBox6.Value = c.Offset(0, 6).Value
.ComboBox2.Value = c.Offset(0, 7).Value
.ComboBox3.Value = c.Offset(0, 8).Value
.N1.Value = c.Offset(0, 9).Value
.N2.Value = c.Offset(0, 10).Value
.N3.Value = c.Offset(0, 11).Value
.N4.Value = c.Offset(0, 12).Value
.NJumlah.Value = c.Offset(0, 13).Value
If c.Offset(0, 14).Value = "V" Then
.Berkas1.Value = True
Else: .Berkas1.Value = False
End If
If c.Offset(0, 15).Value = "V" Then
.Berkas2.Value = True
Else: .Berkas2.Value = False
End If
If c.Offset(0, 16).Value = "V" Then
.Berkas3.Value = True
Else: .Berkas3.Value = False
End If
If c.Offset(0, 17).Value = "V" Then
.Berkas4.Value = True
Else: .Berkas4.Value = False
End If
If c.Offset(0, 18).Value = "V" Then
.Berkas5.Value = True
Else: .Berkas5.Value = False
End If
If c.Offset(0, 19).Value = "V" Then
.Berkas6.Value = True
Else: .Berkas6.Value = False
End If
If c.Offset(0, 20).Value = "V" Then
.Berkas7.Value = True
Else: .Berkas7.Value = False
End If
Cekdulu = .TextBox1.Value
Set FoundRange = Sheets("DatabaseUmum").Cells.Find(What:=Cekdulu, LookIn:=xlFormulas, Lookat:=xlWhole)
If FoundRange Is Nothing Then
Call PendaftarTidakDitemukan
End If
End With
End Sub
Sub KosongkanFormPendaftar()
With UserForm2
'.TextBox1.Value = ""
.TextBox2.Value = ""
.ComboBox1.Value = ""
.TextBox3.Value = ""
.TextBox4.Value = ""
.TextBox5.Value = ""
.TextBox6.Value = ""
.ComboBox2.Value = ""
.ComboBox3.Value = ""
.N1.Value = ""
.N2.Value = ""
.N3.Value = ""
.N4.Value = ""
.NJumlah.Value = ""
.Berkas1.Value = False
.Berkas2.Value = False
.Berkas3.Value = False
.Berkas4.Value = False
.Berkas5.Value = False
.Berkas6.Value = False
.Berkas7.Value = False
End With
End Sub
Oke, itulah script coding VBA untuk Form PPDB 2016/2017 tidak mengecewakan banyak seh, mohon maaf aku tidak dapat menjelaskan satu per satu mungkin yang sudah jago dalam pembuatan Aplikasi berbasis VBA Excel sudah tidak abnormal lagi namun bagi yang masih dalam proses berguru Insya Allah akan aku jelaskan satu per satu bagaimana cara membuatnya.
Download Aplikasi PPDB Berbasis Excel untuk SMA
Update:
Daripada galau lebih baik silakan cicipi aplikasi PPDB Versi 10.5 di Aplikasi PPDB Terbaru
Sumber http://www.excel-id.com/