Dim selectedRow As Long ' Untuk menyimpan nomor baris yang dipilih
Dim isEditing As Boolean ' Untuk menandai apakah sedang dalam mode edit
Dim blnLoading As Boolean
Private originalHMAwal As Double
Private originalHMAkhir As Double
Private originalTotalHM As Double
Private originalSisaHM As Double
'=======================================
' TOMBOL BERSIHKAN
'=======================================
Private Sub cmdBersihkan_Click()
BersihkanForm
End Sub
Private Sub cmdEdit_Click()
If Me.lsDataInput.ListIndex = -1 Then
MsgBox "Pilih data yang akan diedit ", vbExclamation
Exit Sub
End If
selectedRow = Me.lsDataInput.ListIndex + 2
With ThisWorkbook.Sheets("InputDataHM")
'Isi nilai form
Me.txtTanggal.value = .Cells(selectedRow, 1).value
Me.cmNamaOperator.value = .Cells(selectedRow, 2).value
Me.cmNoUnit.value = .Cells(selectedRow, 3).value
Me.txtAlatBerat.value = .Cells(selectedRow, 4).value
Me.txtTipeAlatBerat.value = .Cells(selectedRow, 5).value
Me.txtMerkAlatBerat.value = .Cells(selectedRow, 6).value
Me.cmshift.value = .Cells(selectedRow, 7).value
Me.txtHMAwal.value = .Cells(selectedRow, 8).value
Me.txtHMAkhir.value = .Cells(selectedRow, 9).value
Me.txtTotalHm.value = .Cells(selectedRow, 10).value
Me.txtSisaHM.value = .Cells(selectedRow, 11).value
Me.txtKegiatan.value = .Cells(selectedRow, 12).value
'Simpan nilai asli untuk perhitungan
originalHMAwal = .Cells(selectedRow, 8).value
originalHMAkhir = .Cells(selectedRow, 9).value
originalTotalHM = .Cells(selectedRow, 10).value
originalSisaHM = .Cells(selectedRow, 11).value
End With
isEditing = True
MsgBox "Edit data dan klik Simpan untuk menyimpan perubahan.", vbInformation
End Sub
Private Sub cmdHapus_Click()
' Validasi pemilihan data
If Me.lsDataInput.ListIndex = -1 Then
MsgBox "Pilih data yang akan dihapus !", vbExclamation
Exit Sub
End If
' Konfirmasi penghapusan
Dim confirm As VbMsgBoxResult
confirm = MsgBox("Apakah Anda yakin ingin menghapus data ini?", vbYesNo +
vbQuestion, "Konfirmasi Hapus")
If confirm = vbYes Then
Dim wsInput As Worksheet
Dim wsMaster As Worksheet
Dim selectedRow As Long
Dim noUnit As String
Dim hmAkhir As Double
Set wsInput = ThisWorkbook.Sheets("InputDataHM")
Set wsMaster = ThisWorkbook.Sheets("MasterAlat")
' Ambil data sebelum dihapus
selectedRow = Me.lsDataInput.ListIndex + 2
noUnit = wsInput.Cells(selectedRow, 3).value ' Asumsi NoUnit di kolom C
hmAkhir = wsInput.Cells(selectedRow, 9).value ' Asumsi HM Akhir di kolom I
' Hapus baris di InputDataHM
wsInput.Rows(selectedRow).Delete shift:=xlUp
' Update HM Akhir di MasterAlat
UpdateMasterAlat noUnit, hmAkhir
' Bersihkan form dan muat ulang data
BersihkanForm
LoadDataToListBox
MsgBox "Data berhasil dihapus!", vbInformation
End If
End Sub
Sub UpdateMasterAlat(noUnit As String, deletedHMAkhir As Double)
Dim wsMaster As Worksheet
Dim lastRow As Long
Dim i As Long
Dim maxHM As Double
Set wsMaster = ThisWorkbook.Sheets("MasterAlat")
lastRow = wsMaster.Cells(wsMaster.Rows.Count, "D").End(xlUp).Row ' Asumsi
NoUnit di kolom D
' Cari NoUnit di MasterAlat
For i = 2 To lastRow
If wsMaster.Cells(i, 2).value = noUnit Then
' Jika HM Akhir di Master sama dengan yang dihapus
If wsMaster.Cells(i, 8).value = deletedHMAkhir Then ' Asumsi HM Akhir
di kolom H
' Cari HM Akhir terbaru dari InputDataHM
maxHM = CariHMTerbaru(noUnit)
' Update nilai di MasterAlat
If maxHM > 0 Then
wsMaster.Cells(i, 8).value = maxHM
Else
' Jika tidak ada data lain, reset ke HM Awal
wsMaster.Cells(i, 8).value = wsMaster.Cells(i, 7).value '
Asumsi HM Awal di kolom G
End If
End If
Exit For
End If
Next i
End Sub
Function CariHMTerbaru(noUnit As String) As Double
Dim wsInput As Worksheet
Dim lastRow As Long
Dim i As Long
Dim maxHM As Double
Set wsInput = ThisWorkbook.Sheets("InputDataHM")
lastRow = wsInput.Cells(wsInput.Rows.Count, "C").End(xlUp).Row ' Asumsi NoUnit
di kolom C
maxHM = 0
' Cari HM terbesar untuk NoUnit yang sama
For i = 2 To lastRow
If wsInput.Cells(i, 3).value = noUnit Then
If wsInput.Cells(i, 9).value > maxHM Then ' Asumsi HM Akhir di kolom I
maxHM = wsInput.Cells(i, 9).value
End If
End If
Next i
CariHMTerbaru = maxHM
End Function
Private Sub cmdSimpan_Click()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("InputDataHM")
Dim masterWs As Worksheet
Set masterWs = ThisWorkbook.Sheets("MasterAlat")
' Validasi data wajib
If Me.txtTanggal.value = "" Or Me.cmNamaOperator.value = "" Or
Me.cmNoUnit.value = "" Or _
Me.txtHMAwal.value = "" Or Me.txtHMAkhir.value = "" Or Me.txtKegiatan.value
= "" Or Me.cmshift.value = "" Then
MsgBox "Data Wajib Diisi Lengkap!", vbExclamation
Exit Sub
End If
' Validasi HM Akhir > HM Awal
If CDbl(Me.txtHMAkhir.value) < CDbl(Me.txtHMAwal.value) Then
MsgBox "HM Akhir harus lebih besar dari HM Awal!", vbExclamation
Exit Sub
End If
Dim totalHM As Double
Dim sisaHM As Double
Dim originalHMAkhir As Double
Dim originalTotalHM As Double
Dim originalSisaHM As Double
If Not isEditing Then
' Hitung Total HM untuk data baru
totalHM = CDbl(Me.txtHMAkhir.value) - CDbl(Me.txtHMAwal.value)
Else
' Ambil nilai asli dari database saat edit
originalHMAkhir = ws.Cells(selectedRow, 9).value
originalTotalHM = ws.Cells(selectedRow, 10).value
originalSisaHM = ws.Cells(selectedRow, 11).value
' Cek apakah HM Akhir diubah
If CDbl(Me.txtHMAkhir.value) <> originalHMAkhir Then
' Jika HM Akhir diubah: HITUNG ULANG TOTAL HM & SISA HM
totalHM = CDbl(Me.txtHMAkhir.value) - CDbl(Me.txtHMAwal.value)
Else
' Jika HM Akhir tidak diubah: PAKAI NILAI ASLI
totalHM = originalTotalHM
sisaHM = originalSisaHM
End If
End If
' Hitung Sisa HM hanya untuk data baru atau jika HM Akhir diubah saat edit
If Not isEditing Or (isEditing And CDbl(Me.txtHMAkhir.value) <>
originalHMAkhir) Then
Dim masterRow As Variant
masterRow = Application.Match(Me.cmNoUnit.value, masterWs.Range("D2:D" &
masterWs.Cells(masterWs.Rows.Count, "D").End(xlUp).Row), 0)
If IsError(masterRow) Then
MsgBox "No Unit tidak ditemukan di MasterAlat!", vbExclamation
Exit Sub
Else
Dim minimalCharge As Double
minimalCharge = masterWs.Cells(masterRow + 1, 13).value
Dim lastSisaHM As Double
lastSisaHM = GetLastSisaHM(Me.cmNoUnit.value, Me.txtTanggal.value)
sisaHM = lastSisaHM - totalHM
End If
End If
' Update MasterAlat HANYA jika:
' - Data baru, ATAU
' - Edit dengan perubahan HM Akhir
If Not isEditing Or (isEditing And CDbl(Me.txtHMAkhir.value) <>
originalHMAkhir) Then
Dim masterRowUpdate As Variant
masterRowUpdate = Application.Match(Me.cmNoUnit.value,
masterWs.Range("D2:D" & masterWs.Cells(masterWs.Rows.Count, "D").End(xlUp).Row), 0)
If Not IsError(masterRowUpdate) Then
masterWs.Cells(masterRowUpdate + 1, 8).value = Me.txtHMAkhir.value
End If
End If
' Update warna Sisa HM
sisaHM = Abs(sisaHM)
Me.txtSisaHM.value = sisaHM
Me.txtSisaHM.ForeColor = IIf(sisaHM > minimalCharge, RGB(255, 0, 0), RGB(0, 0,
0))
' Simpan data
If isEditing Then
With ws
.Cells(selectedRow, 1).value = Me.txtTanggal.value
.Cells(selectedRow, 2).value = Me.cmNamaOperator.value
.Cells(selectedRow, 3).value = Me.cmNoUnit.value
.Cells(selectedRow, 4).value = Me.txtAlatBerat.value
.Cells(selectedRow, 5).value = Me.txtTipeAlatBerat.value
.Cells(selectedRow, 6).value = Me.txtMerkAlatBerat.value
.Cells(selectedRow, 7).value = Me.cmshift.value
.Cells(selectedRow, 8).value = Me.txtHMAwal.value
.Cells(selectedRow, 9).value = Me.txtHMAkhir.value
.Cells(selectedRow, 10).value = totalHM
.Cells(selectedRow, 11).value = sisaHM
.Cells(selectedRow, 12).value = Me.txtKegiatan.value
End With
MsgBox "Data berhasil diperbarui!", vbInformation
Else
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
With ws
.Cells(lastRow, 1).value = Me.txtTanggal.value
.Cells(lastRow, 2).value = Me.cmNamaOperator.value
.Cells(lastRow, 3).value = Me.cmNoUnit.value
.Cells(lastRow, 4).value = Me.txtAlatBerat.value
.Cells(lastRow, 5).value = Me.txtTipeAlatBerat.value
.Cells(lastRow, 6).value = Me.txtMerkAlatBerat.value
.Cells(lastRow, 7).value = Me.cmshift.value
.Cells(lastRow, 8).value = Me.txtHMAwal.value
.Cells(lastRow, 9).value = Me.txtHMAkhir.value
.Cells(lastRow, 10).value = totalHM
.Cells(lastRow, 11).value = sisaHM
.Cells(lastRow, 12).value = Me.txtKegiatan.value
End With
MsgBox "Data baru berhasil ditambahkan!", vbInformation
End If
isEditing = False
BersihkanForm
LoadDataToListBox
End Sub
Private Function GetLastSisaHM(noUnit As String, tanggal As String) As Double
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("InputDataHM")
' 1. Cari data sebelumnya untuk unit yang sama
Dim previousSisaHM As Double
previousSisaHM = -1
' Loop mundur untuk mencari data terakhir sebelum tanggal input
Dim i As Long
For i = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row To 2 Step -1
If ws.Cells(i, 3).value = noUnit And ws.Cells(i, 1).value < tanggal Then
previousSisaHM = ws.Cells(i, 11).value
Exit For
End If
Next i
' 2. Jika tidak ada data sebelumnya, ambil Minimal Charge dari MasterAlat
If previousSisaHM = -1 Then
Dim masterWs As Worksheet
Set masterWs = ThisWorkbook.Sheets("MasterAlat")
Dim masterRow As Variant
masterRow = Application.Match(noUnit, masterWs.Range("D2:D" &
masterWs.Cells(masterWs.Rows.Count, "D").End(xlUp).Row), 0)
If Not IsError(masterRow) Then
previousSisaHM = masterWs.Cells(masterRow + 1, 13).value
Else
previousSisaHM = 0
End If
End If
' 3. Hitung total HM digunakan pada tanggal yang sama
Dim totalHMDigunakan As Double
totalHMDigunakan = 0
For i = 2 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
If ws.Cells(i, 3).value = noUnit And ws.Cells(i, 1).value = tanggal Then
totalHMDigunakan = totalHMDigunakan + ws.Cells(i, 10).value
End If
Next i
' 4. Hitung Sisa HM
Dim sisaHM As Double
sisaHM = previousSisaHM - totalHMDigunakan
If sisaHM < 0 Then sisaHM = previousSisaHM - totalHMDigunakan
GetLastSisaHM = sisaHM
End Function
Private Sub cmdTanggal_Click()
Call AdvancedCalendar
End Sub
Private Sub cmdKeluar_Click()
' Tutup UserForm saat ini
Me.Hide
' Periksa apakah MenuUtama sudah dimuat
If Not IsFormLoaded("MenuUtama") Then
MenuUtama.Show
End If
End Sub
' Fungsi untuk memeriksa apakah UserForm sudah dimuat
Function IsFormLoaded(formName As String) As Boolean
Dim frm As Object
On Error Resume Next
Set frm = InputHm
On Error GoTo 0
IsFormLoaded = Not frm Is Nothing
End Function
Private Sub txtHMAkhir_Change()
If isEditing Then UpdateCalculations
End Sub
Private Sub txtHMAwal_Change()
If isEditing Then UpdateCalculations
End Sub
Private Sub UserForm_Activate()
End Sub
Private Sub UserForm_Initialize()
On Error Resume Next
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("MasterAlat")
' Jika sheet MasterAlat tidak ditemukan
If ws Is Nothing Then
MsgBox "Sheet MasterAlat tidak ditemukan!", vbCritical
Exit Sub
End If
' Isi ComboBox dengan data unik
FillUniqueCombo Me.cmNamaOperator, ws.Range("E2:E" & ws.Cells(ws.Rows.Count,
"E").End(xlUp).Row)
FillUniqueCombo Me.cmNoUnit, ws.Range("D2:D" & ws.Cells(ws.Rows.Count,
"D").End(xlUp).Row)
' Isi pilihan shift
cmshift.AddItem "Pagi"
cmshift.AddItem "Siang"
cmshift.AddItem "Malam"
cmshift.AddItem "Long Shift"
' Muat data ke ListBox
LoadDataToListBox
Me.txtHMAwal.Enabled = False
End Sub
Private Sub FillUniqueCombo(cmb As ComboBox, rng As Range)
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim cell As Range
For Each cell In rng
If Not IsEmpty(cell.value) And Not dict.Exists(cell.value) Then
dict.Add cell.value, cell.value
End If
Next cell
cmb.List = dict.Keys
End Sub
'=======================================
' FUNGSI BANTU
'=======================================
Sub LoadDataToListBox()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("InputDataHM")
' Cari baris terakhir yang berisi data
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
' Set jumlah kolom di ListBox
Me.lsDataInput.ColumnCount = 12
' Aktifkan ColumnHeads untuk menampilkan header
Me.lsDataInput.ColumnHeads = True
' Set RowSource untuk mencakup header dan data
Me.lsDataInput.RowSource = "InputDataHM!A2:L" & lastRow
End Sub
Sub BersihkanForm()
Me.txtTanggal.value = ""
Me.cmNamaOperator.value = ""
Me.cmNoUnit.value = ""
Me.txtAlatBerat.value = ""
Me.txtTipeAlatBerat.value = ""
Me.txtMerkAlatBerat.value = ""
Me.cmshift.value = ""
Me.txtHMAwal.value = ""
Me.txtHMAkhir.value = ""
Me.txtSisaHM.value = ""
Me.txtTotalHm.value = ""
Me.txtKegiatan.value = ""
isEditing = False
End Sub
Private Sub cmNoUnit_Change()
' Nonaktifkan jika sedang dalam mode edit atau loading data
If isEditing Or blnLoading Then Exit Sub
Dim wsInput As Worksheet
Dim wsMaster As Worksheet
Dim noUnit As String
Dim lastRowInput As Long
Dim i As Long
Dim latestHMAkhir As Double
Dim masterRow As Variant
Set wsInput = ThisWorkbook.Sheets("InputDataHM")
Set wsMaster = ThisWorkbook.Sheets("MasterAlat")
Set masterWs = ThisWorkbook.Sheets("MasterAlat")
noUnit = Me.cmNoUnit.value
' Reset nilai HM Awal jika No Unit kosong
If noUnit = "" Then
Me.txtHMAwal.value = ""
Exit Sub
End If
' Cari HM Akhir terakhir di InputDataHM untuk No Unit ini
lastRowInput = wsInput.Cells(wsInput.Rows.Count, 3).End(xlUp).Row ' Kolom C
(No Unit)
latestHMAkhir = -1 ' Flag untuk menandai apakah ada data sebelumnya
' Loop dari baris terakhir ke atas untuk mencari data terbaru
For i = lastRowInput To 2 Step -1
If wsInput.Cells(i, 3).value = noUnit Then
latestHMAkhir = wsInput.Cells(i, 9).value ' Kolom 9 (HM Akhir)
Exit For
End If
Next i
' Jika ditemukan HM Akhir sebelumnya, isi ke HM Awal
If latestHMAkhir <> -1 Then
Me.txtHMAwal.value = latestHMAkhir
Else
' Jika tidak ada data sebelumnya, ambil HM Awal dari MasterAlat
masterRow = Application.Match(noUnit, wsMaster.Range("D2:D" &
wsMaster.Cells(wsMaster.Rows.Count, "D").End(xlUp).Row), 0)
If Not IsError(masterRow) Then
Me.txtHMAwal.value = wsMaster.Cells(masterRow + 1, 7).value ' Kolom 7
(HM Awal di MasterAlat)
Else
Me.txtHMAwal.value = ""
MsgBox "No Unit tidak ditemukan di MasterAlat!", vbExclamation
End If
End If
If noUnit = "" Then
Me.txtAlatBerat.value = ""
Me.txtTipeAlatBerat.value = ""
Me.txtMerkAlatBerat.value = ""
Exit Sub
End If
' Cari data di MasterAlat berdasarkan No Unit (Kolom D)
masterRow = Application.Match(noUnit, masterWs.Range("D2:D" &
masterWs.Cells(masterWs.Rows.Count, "D").End(xlUp).Row), 0)
If Not IsError(masterRow) Then
' Ambil data dari kolom terkait (sesuaikan dengan struktur kolom di
MasterAlat)
Me.txtAlatBerat.value = masterWs.Cells(masterRow + 1, 1).value ' Kolom B:
Jenis Alat Berat
Me.txtTipeAlatBerat.value = masterWs.Cells(masterRow + 1, 2).value ' Kolom
C: Tipe Alat
Me.txtMerkAlatBerat.value = masterWs.Cells(masterRow + 1, 3).value ' Kolom
E: Merk Alat Berat
Else
Me.txtAlatBerat.value = ""
Me.txtTipeAlatBerat.value = ""
Me.txtMerkAlatBerat.value = ""
MsgBox "Data tidak ditemukan di MasterAlat!", vbExclamation
End If
End Sub
Private Sub UpdateCalculations()
On Error Resume Next
Dim newHMAwal As Double
Dim newHMAkhir As Double
Dim newTotalHM As Double
Dim newSisaHM As Double
'Ambil nilai baru
newHMAwal = CDbl(Me.txtHMAwal.value)
newHMAkhir = CDbl(Me.txtHMAkhir.value)
'Hitung Total HM baru
newTotalHM = newHMAkhir - newHMAwal
Me.txtTotalHm.value = newTotalHM
'Hitung Sisa HM berdasarkan perubahan
newSisaHM = originalSisaHM - (newTotalHM - originalTotalHM)
Me.txtSisaHM.value = newSisaHM
On Error GoTo 0
End Sub
