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.

MEMBUAT FORM ISIAN DATA SEDERHANA DI EXCEL

Terkadang kita merasa jenuh mengisi table di excel, untuk membuang kejenuhan mengisi
data saya coba iseng iseng membuat form sederhana untuk sekedar membuang kejenuhan…..
Selanjutnya anda bias mengembangkan sesuai dengan kebutuhan…….
Adapun langkah-langkah pembuatan form sebagai berikut :
1. Buka file excel 2007
2. Double Klik di nama worksheet lalu ganti nama yg asalnya Sheet1 menjadi
“PARTSDATA” (ini mah klo saya, klo anda terserah tapi perlu diingat namanya untuk
pembuatan code)
3. Pada Row 1 kolom kita buat nama heading untuk tabelnya seperti tampak pada gambar
dibawah ini :

4. Kemudian kita simpan file sebagai excel makro….klik file save as pilih Excel Macro
Enabled Workbook….ketik nama file disini saya beri nama file “data barang”

Langkah berikutnya membuat Macro untuk file tersebut, adapun langkah-langkah pembuatan
macro sebagai berikut :
1. Pada worksheet pilih menu view klik tab Macros pilih view macros :
2. Isikan macro name : “FORM” klik create :

3. Klik kanan mouse pada VBA Project

4. Pilih insert
5. Pilih user form :
Langkah selanjutnya adalah design form dengan Control yang akan kita gunakan adalah :
Control Label, Textbox dan Command Button seperti tampak pada gambar berikut :

Langkah selanjutnya adalah member nama dan caption untuk tiap label, textbox dan
command button

Label1 Caption diganti dengan “Kode”

Label2 Caption diganti dengan “Nama Barang”
Label3 Caption diganti dengan “Satuan”
Label4 Caption diganti dengan “Harga”
TextBox1 Name diganti dengan “tkode”
TextBox2 Name diganti dengan “tnama”
TextBox3 Name diganti dengan “tsatuan”
TextBox4 Name diganti dengan “tharga”

command button1 Caption diganti dengan “TAMBAH”

command button1 Name diganti dengan “CMDTMBH”
command button2 Caption diganti dengan “TUTUP”
command button2 Name diganti dengan “CMDTTP”

atur sedemikian rupa hingga tampak seperti gambar dibawah ini

Langkah selanjutnya adalah membuat kode

1. Klik command button “TAMBAH “
2. Klik menu bar pilih view code
Atau klik kanan mouse pada tombol “TAMBAH” pilih view code

3. Masukan kode dibawah ini (biar gak cape copy paste saja code dibawah ini):

Private Sub CMDTMBH_Click()

Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets(“PARTSDATA”)

‘menemukan baris kosong pada database

iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row

‘check untuk sebuah kode

If Trim(Me.tkode.Value) = “” Then
Me.tkode.SetFocus
MsgBox “Masukan Kode Barang”
Exit Sub
End If

‘copy data ke database

ws.Cells(iRow, 1).Value = Me.tkode.Value
ws.Cells(iRow, 2).Value = Me.tnama.Value
ws.Cells(iRow, 3).Value = Me.tsatuan.Value
ws.Cells(iRow, 4).Value = Me.tharga.Value

‘clear data
Me.tkode.Value = “”
Me.tnama.Value = “”
Me.tsatuan.Value = “”
Me.tharga.Value = “”
Me.tkode.SetFocus
End Sub

4. Dilanjutkan dengan pengisian code pada tombol tutup langkah seperti nomor 2 diatas
dengan kode dibawah ini :

Private Sub CMDTTP_Click()

Unload Me
End Sub

5. Untuk menghindari menutup melalui tanda X pada form masukan kode dibawah ini dengan
klik kanan mouse pada form dan pilih view code dan ketikan kode dibawah ini :

Private Sub UserForm_QueryClose(Cancel As Integer, _

CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
MsgBox “MAKE TOMBOL ATUH KANG!”
End If
End Sub

6. Mengisi code pada module klik kanan module pilih view code dan isikan kode dibawah ini
:
Sub FORM()
UserForm1.Show
End Sub

Sekarang kita kembali ke worksheet kmudian kita akan membuat tombol untuk mengaktifkan
form…terserah dmana saja menyimpannya…
Buat rectangle seperti digambar tersebut untuk memasukkan kode klik kanan mouse pada
rectangle tersebut lalu pilih “Assign Macro” lalu pilih form…..selesai sudah…jika benar
sesuai urutan maka akan tampak seperti ini…..jangan lupa simpen ya….selamat mencoba….