Coding VBA Aplikasi PPDB 2016-2017 untuk Form Pendaftaran

Masih ingat Aplikasi PPDB yang pernah saya posting dan bagikan secara gratis di blog excel ini? Jika ya, saya akan coba membuat dan membagikan coding atau script PPDB untuk tahun 2016/2017. 

Coding ini saya bagikan sebagai bahan pembelajaran lebih lanjut tentang 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 disesuaikan dengan Aplikasi DAPODIK terbaru untuk tingkat SMA/SMK sehingga ketika upload pendaftar siswa baru bisa langsung saja melalui Excel.

Form Pendaftaran siswa baru ini merupakan pengembangan dari versi aplikasi PPDB sebelumnya, mudah-mudahan ke depan nanti bisa bermanfaat baik untuk digunakan maupun dalam hal pembelajaran pembuatan aplikasi berbasis Exel ini.

Simak :
Aplikasi PPDB Terbaru

Berikut tampilan Form Pendaftaran PPDB Tahun 2016/2017

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 tidak boleh kosong"
    Exit Sub
End If
If Trim(Me.TextBox4.Value) = "" Then
    Me.TextBox4.SetFocus
    MsgBox "Tempat lahir tidak boleh 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 pendaftaran tidak boleh 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()
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

Coding Pencarian Data Melalui Nomor Registrasi Pendaftar

Private Sub TextBox1_Change()
If TextBox1.Value = "" Then
      TextBox1.Value = "REG-" & Worksheets("TabelBantu").Cells(2, 6).Value
   Else
   Call CariPendaftar
End If
End Sub

Coding Checkbox Penguncian Nomor Registrasi

Private Sub CheckBox8_Click()
If CheckBox8.Value = True Then
TextBox1.Enabled = False
Else
TextBox1.Enabled = True
End If
End Sub

Coding Penjumlahan Nilai UN SMP/MTS

Sub JumlahkanNilai()
    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

Coding Perubahan ketika Perubahan Nilai UN untuk setiap Mata Pelajaran UN

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()
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

Coding untuk ListPendaftaran

Private Sub ListPendaftar()
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

Coding VBA untuk UserForm Initialize

Private Sub UserForm_Initialize()
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

Coding Untuk Pewarnaan 

Private Sub TulisCariNama_LostFocus()
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

Modul Pencarian Data Pendaftar

Sub CariPendaftar()
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

Modul Untuk Mengosongkan Data Pendaftar
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 lumayan banyak seh, mohon maaf saya tidak bisa menjelaskan satu per satu mungkin yang sudah ahli dalam pembuatan Aplikasi berbasis VBA Excel sudah tidak asing lagi namun bagi yang masih dalam proses belajar Insya Allah akan saya jelaskan satu per satu bagaimana cara membuatnya.

Download Aplikasi PPDB Berbasis Excel untuk SMA

Update:
Daripada bingung lebih baik silakan cicipi aplikasi PPDB Versi 10.5 di Aplikasi PPDB Terbaru

Tweet