This document contains coding for a form task in Excel VBA. It includes coding for initializing the form, populating dropdowns and textboxes from sheets, calculating totals, adding, updating, deleting and searching tasks, and resetting the form fields. The coding manages input validation, error handling, and updating source data and lists on the sheets.
This document contains coding for a form task in Excel VBA. It includes coding for initializing the form, populating dropdowns and textboxes from sheets, calculating totals, adding, updating, deleting and searching tasks, and resetting the form fields. The coding manages input validation, error handling, and updating source data and lists on the sheets.
This document contains coding for a form task in Excel VBA. It includes coding for initializing the form, populating dropdowns and textboxes from sheets, calculating totals, adding, updating, deleting and searching tasks, and resetting the form fields. The coding manages input validation, error handling, and updating source data and lists on the sheets.
This document contains coding for a form task in Excel VBA. It includes coding for initializing the form, populating dropdowns and textboxes from sheets, calculating totals, adding, updating, deleting and searching tasks, and resetting the form fields. The coding manages input validation, error handling, and updating source data and lists on the sheets.
Download as DOCX, PDF, TXT or read online from Scribd
Download as docx, pdf, or txt
You are on page 1of 6
CODING FORM TASK
1. CODING USERFORM INITIALIZE
'Perintah memasukkan data dari sheet ke listbox On Error Resume Next Me.CBCODE.RowSource = Sheet2.Range("TABELPROJECT").Address(External:=True) Me.TASKTABLE.RowSource = Sheet3.Range("TABELTASK").Address(External:=True) Me.CBSEARCHPROJECT.RowSource = Sheet2.Range("NAMAPROJECT").Address(External:=True)
2. CODING COMBOBOX CODE PROJECT
'On Error GoTo ExcelVba Set CariProject = Sheet2.Range("A6:A10000").Find(What:=Me.CBCODE.Value, LookIn:=xlValues) Me.TXTPROJECT.Value = CariProject.Offset(0, 1).Value Me.TXTSTART.Value = CariProject.Offset(0, 2).Value Me.TXTEND.Value = CariProject.Offset(0, 3).Value Me.TXTDURATION.Value = CariProject.Offset(0, 3).Value - CariProject.Offset(0, 2).Value & " Hari" Me.TXTEND.Value = Format(Me.TXTEND.Value, "DD/MM/YYYY") Me.TXTSTART.Value = Format(Me.TXTSTART.Value, "DD/MM/YYYY") Exit Sub ExcelVba: Call MsgBox("Pilih Project yang hanya terdapat pada pilihan", vbInformation, "Pilih Project")
3. CODING TEXTBOX WORK BUDGET
Private Sub TXTWORK_Change() On Error Resume Next Me.TXTTOTAL.Value = IIf(Me.TXTMATERIAL.Value = "", 0, Me.TXTMATERIAL.Value) + 0 + IIf(Me.TXTWORK.Value = "", 0, Me.TXTWORK.Value) End Sub 4. CODING TEXTBOX MATERIAL Private Sub TXTMATERIAL_Change() On Error Resume Next Me.TXTTOTAL.Value = IIf(Me.TXTMATERIAL.Value = "", 0, Me.TXTMATERIAL.Value) + 0 + IIf(Me.TXTWORK.Value = "", 0, Me.TXTWORK.Value) End Sub 5. CODING TOMBOL ADD 'Perintah membuat nama tempat simpan data Dim DBTASK As Object 'Perintah menentukan letak tempat simpan data Set DBTASK = Sheet3.Range("A100000").End(xlUp) If Me.CBCODE.Value = "" _ Or Me.TXTPROJECT.Value = "" _ Or Me.TXTTASK.Value = "" _ Or Me.DTSTART.Value = "" _ Or Me.DTEND.Value = "" _ Or Me.TXTWORK.Value = "" _ Or Me.TXTMATERIAL.Value = "" _ Or Me.TXTTOTAL.Value = "" Then
Call MsgBox("Maaf, data input harus lengkap", vbInformation, "Input Data")
Else 'Perintah menyimpan data di tempat simpan data DBTASK.Offset(1, 0).Value = Me.CBCODE.Value DBTASK.Offset(1, 1).Value = Me.TXTPROJECT.Value DBTASK.Offset(1, 2).Value = Me.TXTTASK.Value DBTASK.Offset(1, 3).Value = Me.DTSTART.Value DBTASK.Offset(1, 4).Value = Me.DTEND.Value DBTASK.Offset(1, 5).Value = Me.TXTWORK.Value DBTASK.Offset(1, 6).Value = Me.TXTMATERIAL.Value DBTASK.Offset(1, 7).Value = Me.TXTTOTAL.Value
'Perintah memasukkan data dari sheet ke listbox
On Error Resume Next Me.TASKTABLE.RowSource = Sheet3.Range("TABELTASK").Address(External:=True)
'Perintah memunculkan pesan ketika data berhasil disimpan
Call MsgBox("Data project berhasil disimpan!", vbInformation, "Input Project") 'Perintah membersihkan form setelah data tersimpan Me.CBCODE.Value = "" Me.TXTPROJECT.Value = "" Me.TXTTASK.Value = "" Me.TXTWORK.Value = "" Me.TXTMATERIAL.Value = "" Me.TXTTOTAL.Value = "" Me.TXTSTART.Value = "" Me.TXTEND.Value = "" Me.TXTDURATION.Value = "" End If 6. CODING LISTBOX DOUBLE CLICK 'Perintah Pengganti Error On Error GoTo ExcelVba Application.ScreenUpdating = False 'Perintah memasukkan data dari listbox ke TextBox Me.CBCODE.Value = Me.TASKTABLE.Value Me.TXTTASK.Value = Me.TASKTABLE.Column(2) Me.DTSTART.Value = Me.TASKTABLE.Column(3) Me.DTEND.Value = Me.TASKTABLE.Column(4) Me.TXTWORK.Value = Me.TASKTABLE.Column(5) Me.TXTMATERIAL.Value = Me.TASKTABLE.Column(6) Me.TXTTOTAL.Value = Me.TASKTABLE.Column(7) Me.DTSTART.Value = Format(Me.DTSTART.Value, "DD/MM/YYYY") Me.DTEND.Value = Format(Me.DTEND.Value, "DD/MM/YYYY")
Me.CMDADD.Enabled = False
'Perintah mengaktifkan baris data yang akan diubah
Sheet3.Select SUMBERUBAH = Sheets("TASK").Cells(Rows.Count, "C").End(xlUp).Row Sheets("TASK").Range("C6:C" & SUMBERUBAH).Find(What:=Me.TXTTASK.Value, LookIn:=xlValues, LookAt:=xlWhole).Activate CELLAKTIF = ActiveCell.Offset(0, -2).Row Sheets("TASK").Range("A" & CELLAKTIF & ":H" & CELLAKTIF).Select Sheet1.Select 'Perintah Lanjutan pengganti Error Exit Sub ExcelVba: Call MsgBox("Silahkan klik 2x pada data yang disediakan", vbInformation, "Pilih Data")
7. CODING TOMBOL UPDATE
'Perintah membuat Sumber data yang diubah Application.ScreenUpdating = False Dim BARIS As String 'Perintah mengecek apakah ada data yang diubah If Me.CBCODE.Value = "" Then Call MsgBox("Untuk mengubah Data, Pilih data terlebih dahulu", vbInformation, "Ubah Data") Else
On Error Resume Next Me.TASKTABLE.RowSource = Sheet3.Range("TABELTASK").Address(External:=True) 'Perintah memunculkan pesan bahwa data berhasil diubah Call MsgBox("Data berhasil diubah", vbInformation, "Ubah Data")
'Perintah membersihkan form setelah data tersimpan
'Menentukan Object acuan data yang akan dihapus If Me.CBCODE.Value = "" Then Call MsgBox("Pilih data pada tabel data", vbInformation, "Hapus Data") Else 'Membuat pesan konfirmasi hapus data 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 'Menentukan tempat hapus data, menghapus data dan membersihkan form Set Hapusdata = Sheet3.Range("C6:C500000").Find(What:=Me.TXTTASK.Value, LookIn:=xlValues) Hapusdata.Offset(0, -2).ClearContents Hapusdata.Offset(0, -1).ClearContents 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 On Error Resume Next 'Perintah memasukkan data dari sheet ke listbox Me.TASKTABLE.RowSource = Sheet3.Range("TABELTASK").Address(External:=True) 'Perintah memunculkan pesan data berhasil dihapus Call MsgBox("Data berhasil dihapus", vbInformation, "Hapus Data") 'Perintah membersihkan form setelah data tersimpan Me.CBCODE.Value = "" Me.TXTPROJECT.Value = "" Me.TXTTASK.Value = "" Me.TXTWORK.Value = "" Me.TXTMATERIAL.Value = "" Me.TXTTOTAL.Value = "" Me.TXTSTART.Value = "" Me.TXTEND.Value = "" Me.TXTDURATION.Value = "" 'Perintah mengurutkan data setelah dihapus Call UrutTask
9. CODING URUT DATA TASK
Sub UrutTask() 'Perintah urut data berdasarkan Nama Application.ScreenUpdating = False Sheet3.Select Sheet3.Range("A5:h20000").Sort KEY1:=Range("A5"), Order1:=xlAscending, Header:=xlYes End Sub
10. CODING COMBO CARI
On Error GoTo Salah Set Cari_Data = Sheet3 Cari_Data.Range("J6").Value = "*" & Me.CBSEARCHPROJECT.Value & "*" Cari_Data.Range("A5").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _ Sheet3.Range("J5:K6"), CopyToRange:=Sheet3.Range("M5:T5"), Unique:=False Me.TASKTABLE.RowSource = Sheet3.Range("HASILCARITASK").Address(External:=True) Exit Sub Salah: Call MsgBox("Maaf Data tidak ditemukan", vbInformation, "Cari Data")