Cara Membuat Form Input Bantuan Corona (Covid19)

Posted by Admin

Assalamua'laikum Wr.wb.
Pada kesempatan kali ini saya akan memberikan kepada sobat tentang Cara Membuat Form Input BLT Covid19 Berbasis Vba Excel. Sekedar info saja sekarang ini pemerintah indonesia sangat gencar -gencarnya memberikan Bantuan kepada masyarakat yang terkena imbas pandemi Covid19 ini.

Menurut berita yang berkembang seluruh warga masyarakat indonesia akan mendapatkannya. Tiap-tiap per KK, masyarakat akan mendapatkan bantuan sebesar 600 ribu. Semoga bantuan ini terlaksana dengan baik dan tepat sasaran.

Baiklah sobat saya tidak membahas lebih dalam tentang corona ini, karna bukan bidang saya...hehe Langsung saja Form ini nantinya akan memudahkan para perangkat desa untuk menginput data warga nya yang menerima bantuan corona (Covid19).

Kunjungi Juga: Cara Membuat Aplikasi Reservasi Hotel

FORM INPUT BLT COVID-19

- Pertama, silahkan buka microsoft excel sobat dan buatlah tabel seperti berikut.

Tabel Warga

Form Data Penerima Bantuan

- Kedua, silahkan sobat buat nama range nya. caranya klik tab Formulas - Name Manager - Klik New buatlah nama rangenya TBLWARGA dan buatlah rumusnya seperti berikut, setelah selesai klik Close.

- Ketiga, kita akan membuat form input pada Visual Basic Microsoft Excel, Caranya Kik Tab Developer - Visual Basic, maka jendela Visual Basic Akan muncul, silahkan anda tambahkan 1 buah Form dan desainlah seperti berikut.
Component yang digunakan:

NAMA COMPONENT	JUMLAH
Label	18 Buah
TextBox	10Buah
ComboBox	7 Buah
CommanButton	9 Buah
Listbox	1 Buah

- Keempat, setelah selesai mendisain form input, langkah selanjutnya silahkan anda masukan atau Copas coding di bawah ini.

'Andre Syafirman
'Blog: tutordelphiexcel.blogspot.com
'YouTube: Youtube.com/LundankExcel

Option Explicit

Sub TAMPILDATA()
On Error GoTo SALAH
With TABELBANTUAN
    .RowSource = "TBLWARGA"
    .ColumnCount = 14
    .ColumnWidths = "120, 120, 90, 90, 80, 80, 100, 100, 80, 120, 90, 80, 80, 80"
End With
SALAH:
End Sub

Sub Bersih()
Me.NAMALENGKAP.Value = ""
Me.NIK.Value = ""
Me.JENISKELAMIN.Value = ""
Me.TEMPATLAHIR.Value = ""
Me.TANGGAL.Value = ""
Me.AGAMA.Value = ""
Me.PENDIDIKANTERAKHIR.Value = ""
Me.PEKERJAAN.Value = ""
Me.ALAMAT.Value = ""
Me.STATUS.Value = ""
Me.JUMLAH.Value = ""
Me.SUMBER.Value = ""
Me.JENIS.Value = ""
Me.KETERANGAN.Value = ""
End Sub

Private Sub AGAMA_Change()
Sheet7.Range("C11").Value = Me.AGAMA.Value
End Sub

Private Sub ALAMAT_Change()
Sheet7.Range("C14").Value = Me.ALAMAT.Value

End Sub

Private Sub BATAL_Click()
Call Bersih
Me.NAMALENGKAP.Enabled = True
Me.EDIT.Enabled = False
Me.HAPUS.Enabled = False
Me.SIMPAN.Enabled = True
End Sub

Private Sub CETAKDATAWARGA_Click()
 On Error Resume Next
    Sheet1.PrintOut
    Call MsgBox("Data WARGA Telah di Cetak", vbInformation, "DATA WARGA")
End Sub

Private Sub ComboBox1_Change()
On Error GoTo SALAH
Dim CARIWARGA As Object
'Perintah menentukan tempat pencarian data
Set CARIWARGA = Sheet1
'Perintah Menentukan tempat Kriteria Pencarian
CARIWARGA.Range("X1").Value = Me.ComboBox1.Value
Me.CARIDATA.Enabled = True
Me.CR.Enabled = True
Me.RESET.Enabled = True
SALAH:
End Sub

Private Sub CommandButton2_Click()
 On Error Resume Next
    Sheet7.PrintOut
    Call MsgBox("Data Penerima Bantuan Telah di Cetak", vbInformation, "Penerima Bantuan")
End Sub

Private Sub CR_Click()
On Error GoTo SALAH
Dim CariDataWarga As Object
Set CariDataWarga = Sheet1
CariDataWarga.Range("X1").Value = ComboBox1.Value
CariDataWarga.Range("X2").Value = Me.CARIDATA.Value
CariDataWarga.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Sheet1.Range("X1:X2"), Copytorange:=Sheet1.Range("Z3:AM3"), Unique:=False
Me.TABELBANTUAN.RowSource = Sheet1.Range("CARIDATAWARGA").Address(EXTERNAL:=True)

Exit Sub
SALAH:
Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")
End Sub


Private Sub EDIT_Click()
On Error Resume Next
Dim UbahData As Object
If Me.NAMALENGKAP.Value = "" Then
    Call MsgBox("Pilih Data Pada Tabel Terlebih Dahulu", vbInformation, "Edit Data")
Else
Set UbahData = Sheet1.Range("A2:A50000").Find(What:=Me.NAMALENGKAP.Value, LookIn:=xlValues)
    UbahData.Offset(0, 1).Value = Me.NIK.Value
    UbahData.Offset(0, 2).Value = Me.JENISKELAMIN.Value
    UbahData.Offset(0, 3).Value = Me.TEMPATLAHIR.Value
    UbahData.Offset(0, 4).Value = Me.TANGGAL.Value
    UbahData.Offset(0, 5).Value = Me.AGAMA.Value
    UbahData.Offset(0, 6).Value = Me.PENDIDIKANTERAKHIR.Value
    UbahData.Offset(0, 7).Value = Me.PEKERJAAN.Value
    UbahData.Offset(0, 8).Value = Me.ALAMAT.Value
    UbahData.Offset(0, 9).Value = Me.STATUS.Value
    UbahData.Offset(0, 10).Value = Me.JUMLAH.Value
    UbahData.Offset(0, 11).Value = Me.SUMBER.Value
    UbahData.Offset(0, 12).Value = Me.JENIS.Value
    UbahData.Offset(0, 13).Value = Me.KETERANGAN.Value
    
    UbahData.Offset(0, 10).Value = CDec(UbahData.Offset(0, 10).Value)

    Call TAMPILDATA
    Call MsgBox("Data Berhasil di Update", vbInformation, "Update Data")
    Me.NAMALENGKAP.Enabled = True
    Me.SIMPAN.Enabled = True
    Me.EDIT.Enabled = False
    Me.HAPUS.Enabled = False
    Call Bersih
End If
Exit Sub
End Sub

Private Sub Frame1_Click()

End Sub

Private Sub HAPUS_Click()
'On Error Resume Next
Dim HapusData As Object
If Me.NAMALENGKAP.Value = "" Then
    Call MsgBox("Pilih data pada tabel data terlebih dahulu", vbInformation, "Ubah 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

Set HapusData = Sheet1.Range("A2:A50000").Find(What:=Me.NAMALENGKAP.Value, LookIn:=xlValues)
HapusData.Offset(0, 0).ClearContents
HapusData.Offset(0, 1).ClearContents
HapusData.Offset(0, 2).ClearContents
HapusData.Offset(0, 3).ClearContents
HapusData.Offset(0, 4).ClearContents
HapusData.Offset(0, 5).ClearContents
HapusData.Offset(0, 6).ClearContents
HapusData.Offset(0, 7).ClearContents
HapusData.Offset(0, 8).ClearContents
HapusData.Offset(0, 9).ClearContents
HapusData.Offset(0, 10).ClearContents
HapusData.Offset(0, 11).ClearContents
HapusData.Offset(0, 12).ClearContents
HapusData.Offset(0, 13).ClearContents

Call MsgBox("Data Warga Berhasil di Hapus", vbInformation, "Pilih Data")
Call TAMPILDATA
Me.Label22.Caption = Me.TABELBANTUAN.ListCount
Call Bersih
Call Urut_Warga

Me.NAMALENGKAP.Enabled = True
Me.NIK.Enabled = True
Me.SIMPAN.Enabled = True
Me.EDIT.Enabled = False
Me.HAPUS.Enabled = False
End If
End Sub

Private Sub JENIS_Change()
Sheet7.Range("C18").Value = Me.JENIS.Value

End Sub

Private Sub JENISKELAMIN_Change()
Sheet7.Range("C8").Value = Me.JENISKELAMIN.Value
End Sub

Private Sub JUMLAH_Change()
Sheet7.Range("C16").Value = Me.JUMLAH.Value
Sheet7.Range("C16").Value = CDec(Sheet7.Range("C16").Value)
JUMLAH.Value = Format(JUMLAH.Value, "Rp #,##0")
End Sub

Private Sub JUMLAH_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
On Error GoTo SALAH
Dim a As Object
Select Case KeyAscii
    Case Asc("0") To Asc("9")
Case Else
    KeyAscii = 0
If KeyAscii = a Then
    MsgBox "CUMA ANGKA", vbCritical, "DATA ANGKA"
End If
End Select
SALAH:
End Sub

Private Sub KELUAR_Click()
Unload Me
End Sub

Private Sub KETERANGAN_Change()
Sheet7.Range("C19").Value = Me.KETERANGAN.Value

End Sub

Private Sub NAMALENGKAP_Change()
On Error Resume Next
Sheet7.Range("C7").Value = Me.NAMALENGKAP.Value
End Sub

Private Sub NIK_Change()
Sheet7.Range("C6").Value = Me.NIK.Value
End Sub

Private Sub PEKERJAAN_Change()
Sheet7.Range("C13").Value = Me.PEKERJAAN.Value

End Sub

Private Sub PENDIDIKANTERAKHIR_Change()
Sheet7.Range("C12").Value = Me.PENDIDIKANTERAKHIR.Value

End Sub

Private Sub RESET_Click()
Me.ComboBox1.Value = ""
Me.CARIDATA.Value = ""
Call TAMPILDATA
End Sub

Private Sub SIMPAN_Click()
Dim WARGA As Object
Set WARGA = Sheet1.Range("A50000").End(xlUp)

If Me.NAMALENGKAP.Value = "" _
    Or Me.NIK.Value = "" _
    Or Me.JENISKELAMIN.Value = "" _
    Or Me.TEMPATLAHIR.Value = "" _
    Or Me.TANGGAL.Value = "" _
    Or Me.AGAMA.Value = "" _
    Or Me.PENDIDIKANTERAKHIR.Value = "" _
    Or Me.PEKERJAAN.Value = "" _
    Or Me.STATUS.Value = "" _
    Or Me.JUMLAH.Value = "" _
    Or Me.SUMBER.Value = "" _
    Or Me.JENIS.Value = "" _
    Or Me.KETERANGAN.Value = "" Then
    Call MsgBox("Harap Isi Data WARGA Anda Dengan Lengkap", vbInformation, "Data Barang")
Else
    WARGA.Offset(1, 0).Value = Me.NAMALENGKAP.Value
    WARGA.Offset(1, 1).Value = Me.NIK.Value
    WARGA.Offset(1, 2).Value = Me.JENISKELAMIN.Value
    WARGA.Offset(1, 3).Value = Me.TEMPATLAHIR.Value
    WARGA.Offset(1, 4).Value = Me.TANGGAL.Value
    WARGA.Offset(1, 5).Value = Me.AGAMA.Value
    WARGA.Offset(1, 6).Value = Me.PENDIDIKANTERAKHIR.Value
    WARGA.Offset(1, 7).Value = Me.PEKERJAAN.Value
    WARGA.Offset(1, 8).Value = Me.ALAMAT.Value
    WARGA.Offset(1, 9).Value = Me.STATUS.Value
    WARGA.Offset(1, 10).Value = Me.JUMLAH.Value
    WARGA.Offset(1, 11).Value = Me.SUMBER.Value
    WARGA.Offset(1, 12).Value = Me.JENIS.Value
    WARGA.Offset(1, 13).Value = Me.KETERANGAN.Value
    
    Call MsgBox("Data Warga Berhasil di Simpan", vbInformation, "DATA WARGA")
    
    On Error Resume Next
    Call TAMPILDATA
    Me.Label22.Caption = Me.TABELBANTUAN.ListCount
    Call Bersih
    Call Urut_Warga
End If
End Sub

Private Sub STATUS_Change()
Sheet7.Range("C15").Value = Me.STATUS.Value

End Sub

Private Sub SUMBER_Change()
Sheet7.Range("C17").Value = Me.SUMBER.Value

End Sub

Private Sub TABELBANTUAN_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo SALAH
Me.NAMALENGKAP.Value = Me.TABELBANTUAN.Value
Me.NIK.Value = Me.TABELBANTUAN.Column(1)
Me.JENISKELAMIN.Value = Me.TABELBANTUAN.Column(2)
Me.TEMPATLAHIR.Value = Me.TABELBANTUAN.Column(3)
Me.TANGGAL.Value = Me.TABELBANTUAN.Column(4)
Me.AGAMA.Value = Me.TABELBANTUAN.Column(5)
Me.PENDIDIKANTERAKHIR.Value = Me.TABELBANTUAN.Column(6)
Me.PEKERJAAN.Value = Me.TABELBANTUAN.Column(7)
Me.ALAMAT.Value = Me.TABELBANTUAN.Column(8)
Me.STATUS.Value = Me.TABELBANTUAN.Column(9)
Me.JUMLAH.Value = Me.TABELBANTUAN.Column(10)
Me.SUMBER.Value = Me.TABELBANTUAN.Column(11)
Me.JENIS.Value = Me.TABELBANTUAN.Column(12)
Me.KETERANGAN.Value = Me.TABELBANTUAN.Column(13)

Me.NAMALENGKAP.Enabled = False
Me.SIMPAN.Enabled = False
Me.EDIT.Enabled = True
Me.HAPUS.Enabled = True
Exit Sub
SALAH:
Call MsgBox("Pilih Data pada tabel data", vbInformation, "DATA WARGA")
End Sub

Private Sub TANGGAL_Change()
Sheet7.Range("C10").Value = Me.TANGGAL.Value
End Sub

Private Sub TEMPATLAHIR_Change()
Sheet7.Range("C9").Value = Me.TEMPATLAHIR.Value
End Sub

Private Sub UserForm_Initialize()
On Error Resume Next
Call TAMPILDATA
Me.Label22.Caption = Me.TABELBANTUAN.ListCount

JENISKELAMIN.List = Sheets("LIST").Range("A2:A9").Value
AGAMA.List = Sheets("LIST").Range("B2:B9").Value
PENDIDIKANTERAKHIR.List = Sheets("LIST").Range("C2:C9").Value
PEKERJAAN.List = Sheets("LIST").Range("D2:D9").Value
ALAMAT.List = Sheets("LIST").Range("E2:E9").Value
STATUS.List = Sheets("LIST").Range("F2:F9").Value

With ComboBox1
    .AddItem "NIK"
    .AddItem "Nama Lengkap"
End With

Me.CARIDATA.Enabled = False
Me.CR.Enabled = False
Me.RESET.Enabled = False
Me.EDIT.Enabled = False
Me.HAPUS.Enabled = False
End Sub

Catatan: Silahkan di sesuaikan nama TextBox, Combobox, Lisbox, CommanButton dan Labelnya.

Langkah terakhir, silahkan sobat coba jalankan (klik tombol play/F5).
Bagi yang mau mencoba silahkan download filenya dibawah ini.

FORM INPUT CORONA(COVID19)

Semoga aplikasi sederhana ini bermanfaat.

Download Aplikasi Vba Excel

Cara Membuat Form Input Bantuan Corona (Covid19)

0 komentar