---------------------------------------------
CODING FORM PEMDUDUK - EXCEL & VBA TUTORIAL
---------------------------------------------
Option Explicit
Private Sub CMDCARI_Click()
On Error GoTo Salah
Dim CariData As Object
Set CariData = Sheet2
CariData.Range("M6").Value = Me.CBKATEGORI.Value
CariData.Range("M7").Value = Me.TXTKATAKUNCI.Value
CariData.Range("A6").CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CriteriaRange:= _
Sheet2.Range("M6:M7"), Copytorange:=Sheet2.Range("O6:Y6"), Unique:=False
Call HasilPencarian
Exit Sub
Salah:
Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")
End Sub
Private Sub HasilPencarian()
Dim DBZAKAT As Long
Dim irow As Long
irow = Sheet2.Range("O" & Rows.Count).End(xlUp).Row
DBZAKAT = Application.WorksheetFunction.CountA(Sheet2.Range("O7:O100000"))
If DBZAKAT = 0 Then
Me.TABELDATA.RowSource = ""
Else
Me.TABELDATA.RowSource = "DATAPENDUDUK!O7:Y" & irow
End If
End Sub
Private Sub CMDDELETE_Click()
If Me.TXTNOMOR.Value = "" Then
Call MsgBox("Pilih data pada tabel data", vbInformation, "Hapus Data")
Else
Select Case MsgBox("Anda akan menghapus data" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Hapus data")
Case vbNo
Exit Sub
Case vbYes
End Select
Me.TABELDATA.Value = ""
Me.TXTNOMOR.Value = ""
Sheet2.Select
Selection.EntireRow.Delete
Call AmbilData
Sheet1.Select
Me.TXTNIK.Value = ""
Me.TXTNAMA.Value = ""
Me.CBJENIS.Value = ""
Me.CBSTATUS.Value = ""
Me.CBMENIKAH.Value = ""
Me.TXTALAMAT.Value = ""
Me.TXTRT.Value = ""
Me.TXTRW.Value = ""
Me.CBPEKERJAAN.Value = ""
Me.CBSTATUSPENDUDUK.Value = ""
End If
End Sub
Private Sub CMDRESET_Click()
Me.TXTNIK.Value = ""
Me.TXTNAMA.Value = ""
Me.CBJENIS.Value = ""
Me.CBSTATUS.Value = ""
Me.CBMENIKAH.Value = ""
Me.TXTALAMAT.Value = ""
Me.TXTRT.Value = ""
Me.TXTRW.Value = ""
Me.CBPEKERJAAN.Value = ""
Me.CBSTATUSPENDUDUK.Value = ""
Me.CBKATEGORI.Value = ""
Me.TXTKATAKUNCI.Value = ""
Call AmbilData
End Sub
Private Sub CMDSIMPAN_Click()
Dim DBPENDUDUK As Object
Set DBPENDUDUK = Sheet2.Range("A800000").End(xlUp)
If Me.TXTNIK.Value = "" _
Or Me.TXTNAMA.Value = "" _
Or Me.CBJENIS.Value = "" _
Or Me.CBSTATUS.Value = "" _
Or Me.CBMENIKAH.Value = "" _
Or Me.TXTALAMAT.Value = "" _
Or Me.TXTRT.Value = "" _
Or Me.TXTRW.Value = "" _
Or Me.CBPEKERJAAN.Value = "" _
Or Me.CBSTATUSPENDUDUK.Value = "" Then
Call MsgBox("Harap Isi Data dengan Lengkap", vbInformation, "Input Data")
Else
DBPENDUDUK.Offset(1, 0).Value = "=ROW()-ROW($A$6)"
DBPENDUDUK.Offset(1, 1).Value = "'" & Me.TXTNIK.Value
DBPENDUDUK.Offset(1, 2).Value = Me.TXTNAMA.Value
DBPENDUDUK.Offset(1, 3).Value = Me.CBJENIS.Value
DBPENDUDUK.Offset(1, 4).Value = Me.CBSTATUS.Value
DBPENDUDUK.Offset(1, 5).Value = Me.CBMENIKAH.Value
DBPENDUDUK.Offset(1, 6).Value = Me.TXTALAMAT.Value
DBPENDUDUK.Offset(1, 7).Value = Me.TXTRT.Value
DBPENDUDUK.Offset(1, 8).Value = Me.TXTRW.Value
DBPENDUDUK.Offset(1, 9).Value = Me.CBPEKERJAAN.Value
DBPENDUDUK.Offset(1, 10).Value = Me.CBSTATUSPENDUDUK.Value
Call AmbilData
Call MsgBox("Data berhasil disimpan", vbInformation, "Input Data")
Me.TXTNIK.Value = ""
Me.TXTNAMA.Value = ""
Me.CBJENIS.Value = ""
Me.CBSTATUS.Value = ""
Me.CBMENIKAH.Value = ""
Me.TXTALAMAT.Value = ""
Me.TXTRT.Value = ""
Me.TXTRW.Value = ""
Me.CBPEKERJAAN.Value = ""
Me.CBSTATUSPENDUDUK.Value = ""
End If
End Sub
Private Sub AmbilData()
Dim DBZAKAT As Long
Dim irow As Long
irow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
DBZAKAT = Application.WorksheetFunction.CountA(Sheet2.Range("A7:A100000"))
If DBZAKAT = 0 Then
Me.TABELDATA.RowSource = ""
Else
Me.TABELDATA.RowSource = "DATAPENDUDUK!A7:K" & irow
End If
End Sub
Private Sub CMDUPDATE_Click()
Dim UPDATEDATA As Object
Set UPDATEDATA = Sheet2.Range("A7:A100000").Find(What:=Me.TXTNOMOR.Value,
LookIn:=xlValues)
If Me.TXTNOMOR.Value = "" Then
Call MsgBox("Harap Pilih Data Yang Akan Diupdate", vbInformation, "Update Data")
Else
UPDATEDATA.Offset(0, 1).Value = "'" & Me.TXTNIK.Value
UPDATEDATA.Offset(0, 2).Value = Me.TXTNAMA.Value
UPDATEDATA.Offset(0, 3).Value = Me.CBJENIS.Value
UPDATEDATA.Offset(0, 4).Value = Me.CBSTATUS.Value
UPDATEDATA.Offset(0, 5).Value = Me.CBMENIKAH.Value
UPDATEDATA.Offset(0, 6).Value = Me.TXTALAMAT.Value
UPDATEDATA.Offset(0, 7).Value = Me.TXTRT.Value
UPDATEDATA.Offset(0, 8).Value = Me.TXTRW.Value
UPDATEDATA.Offset(0, 9).Value = Me.CBPEKERJAAN.Value
UPDATEDATA.Offset(0, 10).Value = Me.CBSTATUSPENDUDUK.Value
Call MsgBox("Data berhasil diupdate", vbInformation, "UpdateData")
Me.CMDSIMPAN.Enabled = False
Me.TXTNIK.Value = ""
Me.TXTNAMA.Value = ""
Me.CBJENIS.Value = ""
Me.CBSTATUS.Value = ""
Me.CBMENIKAH.Value = ""
Me.TXTALAMAT.Value = ""
Me.TXTRT.Value = ""
Me.TXTRW.Value = ""
Me.CBPEKERJAAN.Value = ""
Me.CBSTATUSPENDUDUK.Value = ""
Me.TXTNOMOR.Value = ""
Me.TABELDATA.Value = ""
End If
End Sub
Private Sub TABELDATA_Click()
End Sub
Private Sub TABELDATA_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Application.ScreenUpdating = False
On Error GoTo EXCELVBA
Dim SUMBERDATA, CELLAKTIF As Long
Me.TXTNOMOR.Value = Me.TABELDATA.Value
Me.TXTNIK.Value = Me.TABELDATA.Column(1)
Me.TXTNAMA.Value = Me.TABELDATA.Column(2)
Me.CBJENIS.Value = Me.TABELDATA.Column(3)
Me.CBSTATUS.Value = Me.TABELDATA.Column(4)
Me.CBMENIKAH.Value = Me.TABELDATA.Column(5)
Me.TXTALAMAT.Value = Me.TABELDATA.Column(6)
Me.TXTRT.Value = Me.TABELDATA.Column(7)
Me.TXTRW.Value = Me.TABELDATA.Column(8)
Me.CBPEKERJAAN.Value = Me.TABELDATA.Column(9)
Me.CBSTATUSPENDUDUK.Value = Me.TABELDATA.Column(10)
Me.CMDSIMPAN.Enabled = False
Sheet2.Select
SUMBERDATA = Sheets("DATAPENDUDUK").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("DATAPENDUDUK").Range("A7:A" & SUMBERDATA).Find(What:=Me.TXTNOMOR.Value,
LookIn:=xlValues, LookAt:=xlWhole).Activate
CELLAKTIF = ActiveCell.Row
Sheet1.Select
Exit Sub
EXCELVBA:
Call MsgBox("Harap Klik Pada Tabel Data", vbInformation, "Pilih Data")
End Sub
Private Sub UserForm_Initialize()
Call AmbilData
With CBJENIS
.AddItem "Laki - Laki"
.AddItem "Perempuan"
End With
With CBKATEGORI
.AddItem "Nama Penduduk"
.AddItem "Jenis Kelamin"
.AddItem "Status Keluarga"
.AddItem "Status Perkawinan"
.AddItem "RT"
.AddItem "RW"
.AddItem "Status Warga"
End With
With CBMENIKAH
.AddItem "Kawin"
.AddItem "Belum Kawin"
End With
With CBSTATUS
.AddItem "Kepala Keluarga"
.AddItem "Istri"
.AddItem "Anak"
End With
With CBPEKERJAAN
.AddItem "PNS/ASN"
.AddItem "Pedagang"
.AddItem "Swasta"
.AddItem "Wiraswasta"
.AddItem "Buruh Tani"
.AddItem "Pengusaha"
.AddItem "Pelajar"
.AddItem "Buruh"
.AddItem "Belum/Tidak Bekerja"
End With
With CBSTATUSPENDUDUK
.AddItem "Warga Mampu"
.AddItem "Warga Kurang Mampu"
End With
End Sub
