Location via proxy:   [ UP ]  
[Report a bug]   [Manage cookies]                

Coding Form Task

Download as docx, pdf, or txt
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

'Perintah mengubah data dari kolom pertama


BARIS = ActiveCell.Row
Cells(BARIS, 3) = Me.TXTTASK.Value
Cells(BARIS, 4) = Me.DTSTART.Value
Cells(BARIS, 5) = Me.DTEND.Value
Cells(BARIS, 6) = Me.TXTWORK.Value
Cells(BARIS, 7) = Me.TXTMATERIAL.Value
Cells(BARIS, 8) = 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 bahwa data berhasil diubah
Call MsgBox("Data berhasil diubah", vbInformation, "Ubah 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 = ""
End If

8. CODING TOMBOL DELETE


'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")

11. CODING TEXTBOX CARI


On Error GoTo Salah
Set Cari_Data = Sheet3
Cari_Data.Range("K6").Value = "*" & Me.TxtSeacrh.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")
12. CODING TOMBOL RESET
Sheet3.Range("K6").Value = ""
Sheet3.Range("J6").Value = ""
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 = ""
Me.CBSEARCHPROJECT.Value = ""
Me.TxtSeacrh.Value = ""

You might also like