Coding Form Project

CODING FORM PROJECT
1. CODING USERFORM INITIALIZE

'Perintah memasukkan data dari sheet ke listbox
On Error Resume Next
Me.ProjectTable.RowSource = Sheet2.Range("TABELPROJECT").Address(External:=True)
Me.LBDATE.Caption = Now
2. CODING TOMBOL NEW

Sheet2.Range("G3").Value = Sheet2.Range("G3").Value + 1
If Sheet2.Range("G2").Value = 1 Then
Me.TXTCODE.Value = "PRO-1000" & Sheet2.Range("g3").Value
End If
End If
End If
3. CODING TEXTBOX MATERIAL

Me.TXTTOTAL.Value = IIf(Me.TXTMATERIAL.Value = "", 0, Me.TXTMATERIAL.Value) + 0 +
IIf(Me.TXTWORK.Value = "", 0, Me.TXTWORK.Value)
Me.TXTMATERIAL.Value = Format(Me.TXTMATERIAL.Value, "Rp #,###")
Me.TXTTOTAL.Value = Format(Me.TXTTOTAL.Value, "Rp #,###")
4. CODING TEXTBOX TXTWORK

Me.TXTTOTAL.Value = IIf(Me.TXTMATERIAL.Value = "", 0, Me.TXTMATERIAL.Value) + 0 +
IIf(Me.TXTWORK.Value = "", 0, Me.TXTWORK.Value)
Me.TXTWORK.Value = Format(Me.TXTWORK.Value, "Rp #,###")
Me.TXTTOTAL.Value = Format(Me.TXTTOTAL.Value, "Rp #,###")
5. CODING TOMBOL ADD

'Perintah membuat nama tempat simpan data
Dim DBPROJECT As Object
'Perintah menentukan letak tempat simpan data
Set DBPROJECT = Sheet2.Range("A100000").End(xlUp)
If Me.TXTCODE.Value = "" _
Or Me.TXTPROJECT.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
DBPROJECT.Offset(1, 0).Value = Me.TXTCODE.Value
DBPROJECT.Offset(1, 1).Value = Me.TXTPROJECT.Value
DBPROJECT.Offset(1, 2).Value = Me.DTSTART.Value
DBPROJECT.Offset(1, 3).Value = Me.DTEND.Value
DBPROJECT.Offset(1, 4).Value = Me.TXTWORK.Value
DBPROJECT.Offset(1, 5).Value = Me.TXTMATERIAL.Value
DBPROJECT.Offset(1, 6).Value = Me.TXTTOTAL.Value
'Perintah memunculkan pesan ketika data berhasil disimpan

Call MsgBox("Data project berhasil disimpan!", vbInformation, "Input Project")
'Perintah membersihkan form setelah data tersimpan
Me.TXTCODE.Value = ""
Me.TXTPROJECT.Value = ""
Me.TXTWORK.Value = ""
Me.TXTMATERIAL.Value = ""
Me.TXTTOTAL.Value = ""
End If
6. CODING LISTBOX
'Perintah Pengganti Error
Application.ScreenUpdating = False
On Error GoTo ExcelVba
'Perintah memasukkan data dari listbox ke TextBox
Me.TXTCODE.Value = Me.ProjectTable.Value
Me.TXTPROJECT.Value = Me.ProjectTable.Column(1)
Me.DTSTART.Value = Me.ProjectTable.Column(2)
Me.DTEND.Value = Me.ProjectTable.Column(3)
Me.TXTWORK.Value = Me.ProjectTable.Column(4)
Me.TXTMATERIAL.Value = Me.ProjectTable.Column(5)
Me.TXTTOTAL.Value = Me.ProjectTable.Column(6)
Me.DTSTART.Value = Format(Me.DTSTART.Value, "DD/MM/YYYY")
Me.DTEND.Value = Format(Me.DTEND.Value, "DD/MM/YYYY")
Me.CMDCode.Enabled = False
Me.CMDADD.Enabled = False
'Perintah mengaktifkan baris data yang akan diubah

Sheet2.Select
SUMBERUBAH = Sheets("PROJECT").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("PROJECT").Range("A6:A" & SUMBERUBAH).Find(What:=Me.TXTCODE.Value,
LookIn:=xlValues, LookAt:=xlWhole).Activate
CELLAKTIF = ActiveCell.Row
Sheets("PROJECT").Range("A" & CELLAKTIF & ":G" & 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 UPDATE
'Perintah membuat Sumber data yang diubah
Dim BARIS, SUMBERUBAH As String
'Perintah mengecek apakah ada data yang diubah

If Me.TXTCODE.Value = "" Then
Call MsgBox("Untuk mengubah Data, Pilih data terlebih dahulu", vbInformation, "Ubah Data")
Else
'Perintah mengubah data dari kolom pertama

Sheet2.Select
BARIS = ActiveCell.Row
Cells(BARIS, 1) = Me.TXTCODE.Value
Cells(BARIS, 2) = Me.TXTPROJECT.Value
Cells(BARIS, 3) = Me.DTSTART.Value
Cells(BARIS, 4) = Me.DTEND.Value
Cells(BARIS, 5) = Me.TXTWORK.Value
Cells(BARIS, 6) = Me.TXTMATERIAL.Value
Cells(BARIS, 7) = Me.TXTTOTAL.Value
'Perintah memunculkan pesan bahwa data berhasil diubah
Call MsgBox("Data berhasil diubah", vbInformation, "Ubah Data")
Sheet1.Select
End If
8. CODING DELETE
'Menentukan Object acuan data yang akan dihapus
If Me.TXTCODE.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 = Sheet2.Range("A6:A500000").Find(What:=Me.TXTCODE.Value,
LookIn:=xlValues)
Hapusdata.Offset(0, 0).ClearContents
'Perintah update tabel setelah data terhapus
'Perintah memunculkan pesan data berhasil dihapus
Call MsgBox("Data berhasil dihapus", vbInformation, "Hapus Data")
'Perintah mengurutkan data setelah dihapus
Call UrutData
End If
9. CODING URUT DATA
Sub UrutData()
'Perintah urut data berdasarkan Nama
Sheet2.Select
Sheet2.Range("A5:G20000").Sort KEY1:=Range("A5"), Order1:=xlAscending, Header:=xlYes
End Sub
10. CODING RESET

Me.CMDCode.Enabled = True
Me.CMDADD.Enabled = True

Coding Form Project

Uploaded by

Copyright:

Available Formats

Coding Form Project

Uploaded by

Document Information

Original Description:

Original Title

Copyright

Available Formats

Share this document

Share or Embed Document

Sharing Options

Did you find this document useful?

Is this content inappropriate?

Copyright:

Available Formats

Coding Form Project

Uploaded by

Copyright:

Available Formats

CODING FORM PROJECT

1. CODING USERFORM INITIALIZE

2. CODING TOMBOL NEW

3. CODING TEXTBOX MATERIAL

4. CODING TEXTBOX TXTWORK

5. CODING TOMBOL ADD

Call MsgBox("Maaf, data input harus lengkap", vbInformation, "Input Data")

'Perintah memunculkan pesan ketika data berhasil disimpan

'Perintah mengaktifkan baris data yang akan diubah

'Perintah mengecek apakah ada data yang diubah

'Perintah mengubah data dari kolom pertama

10. CODING RESET

You might also like