Simpan
Private Sub CommandButton1_Click()
Dim Dbarang As Object
Set Dbarang = Sheet4.Range("A10000").End(xlUp)
If Me.TextBox1.value = "" _
Or Me.TextBox2.value = "" _
Or Me.Cmbsatuan.value = "" _
Or Me.TextBox4.value = "" Then
Call MsgBox("Data Belum Lengkap,Harap isi data dengan lengkap", vbInformation, "Isi
Data")
Else
Dbarang.Offset(1, 0).value = "=ROW()-ROW($A$5)"
Dbarang.Offset(1, 1).value = Me.TextBox1.value
Dbarang.Offset(1, 2).value = Me.TextBox2.value
Dbarang.Offset(1, 3).value = Me.Cmbsatuan.value
Dbarang.Offset(1, 4).value = Me.TextBox4.value
Call AmbilBarang
Call MsgBox("Data Barang telah disimpan", vbInformation, "Simpan Data")
Me.TextBox1.value = ""
Me.TextBox2.value = ""
Me.Cmbsatuan.value = ""
Me.TextBox4.value = ""
Me.txtNOMOR.value = ""
End If
End Sub
Edit
Private Sub CommandButton2_Click()
Dim SUMBERUBAH As Object
Set SUMBERUBAH = Sheet4.Range("A6:A10000").Find(What:=Me.txtNOMOR.value,
LookIn:=xlValues)
If Me.txtNOMOR.value = "" Then
Call MsgBox("Harap Pilih Data Yang Akan Diubah", vbInformation, "Ubah Data")
Else
SUMBERUBAH.Offset(0, 1).value = Me.TextBox1.value
SUMBERUBAH.Offset(0, 2).value = Me.TextBox2.value
SUMBERUBAH.Offset(0, 3).value = Me.Cmbsatuan.value
SUMBERUBAH.Offset(0, 4).value = Me.TextBox4.value
Call MsgBox("Data Telah Berhasil Diubah", vbInformation, "Ubah Data")
Me.txtNOMOR.value = ""
Me.TextBox1.value = ""
Me.TextBox2.value = ""
Me.Cmbsatuan.value = ""
Me.TextBox4.value = ""
Me.CommandButton1.Enabled = True
End If
End Sub
Hapus
Private Sub CommandButton3_Click()
If Me.txtNOMOR.value = "" Then
Call MsgBox("Pilih data yang akan dihapus pada tabel data", vbInformation, "Hapus
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
Me.TABELBARANG.RowSource = ""
Me.txtNOMOR.value = ""
Me.TextBox1.value = ""
Me.TextBox2.value = ""
Me.Cmbsatuan.value = ""
Me.TextBox4.value = ""
Sheet4.Select
Selection.EntireRow.Delete
Me.CommandButton1.Enabled = True
Me.TextBox1.Enabled = True
Call AmbilBarang
Call MsgBox("Data Berhasil Dihapus", vbInformation, "Hapus Data")
Sheet4.Select
End If
End Sub
Batal
Private Sub CommandButton4_Click()
Me.txtNOMOR.value = ""
Me.TextBox1.value = ""
Me.TextBox2.value = ""
Me.Cmbsatuan.value = ""
Me.TextBox4.value = ""
Me.CommandButton1.Enabled = True
Me.TextBox1.Enabled = True
End Sub
Clik Tabel
Private Sub TABELBARANG_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EXELVBA
Dim SUMBERDATA, CELLAKTIF As Long
Me.txtNOMOR.value = Me.TABELBARANG.value
Me.TextBox1.value = Me.TABELBARANG.Column(1)
Me.TextBox2.value = Me.TABELBARANG.Column(2)
Me.Cmbsatuan.value = Me.TABELBARANG.Column(3)
Me.TextBox4.value = Me.TABELBARANG.Column(4)
Me.CommandButton1.Enabled = False
Me.TextBox1.Enabled = True
'Perintah untuk mengaktifkan baris data yang dipilih
Sheet4.Select
SUMBERDATA = Sheets("DBBARANG").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("DBBARANG").Range("A6:A" & SUMBERDATA).Find(What:=Me.txtNOMOR.value,
LookIn:=xlValues, LookAt:=xlWhole).Activate
CELLAKTIF = ActiveCell.Row
Sheet4.Select
Exit Sub
EXELVBA:
Call MsgBox("Harap PIlih Data Pada Tabel Data", vbInformation, "Pilih Data")
End Sub
Format Uang
Private Sub TextBox4_Change()
On Error Resume Next
Me.TextBox4.value = Format(Me.TextBox4.value, "#,###")
End Sub
Format No HP
Private Sub TextBox5_Change()
If TextBox5.TextLength = 4 Or TextBox5.TextLength = 9 Then
TextBox5.Text = TextBox5.Text + "-"
End If
End Sub
Format Tanggal
Private Sub TextBox2_Change()
If TextBox2.TextLength = 2 Or TextBox2.TextLength = 5 Then
TextBox2.Text = TextBox2.Text + "/"
End If
End Sub
Penjumlahan
Private Sub TXTJUMLAH_Change()
On Error Resume Next
Dim HTOTAL As Long
HTOTAL = Val(CDec(Me.TXTHARGASATUAN.value)) * (Me.TXTJUMLAH.value)
Me.TXTTOTAL.value = Format(HTOTAL, "#,###")
End Sub
Isi Combobox
Private Sub UserForm_Initialize()
Call AmbilBarang
With Cmbsatuan
.AddItem "Kg"
.AddItem "Liter"
.AddItem "Buah"
.AddItem "Batang"
.AddItem "Pack"
.AddItem "Sak"
.AddItem "Kotak"
.AddItem "Pcs"
.AddItem "Lembar"
.AddItem "Gulung"
.AddItem "Meter"
.AddItem "Truk"
.AddItem "Dus"
.AddItem "Kaleng"
.AddItem "Rim"
.AddItem "Unit"
.AddItem "Bungkus"
.AddItem "Biji"
End With
End Sub
Tampilkan Tabel
Private Sub AmbilBarang()
Dim Dbarang As Long
Dim irow As Long
irow = Sheet4.Range("A" & Rows.Count).End(xlUp).Row
Dbarang = Application.WorksheetFunction.CountA(Sheet4.Range("A6:A1000"))
If Dbarang = 0 Then
Me.TABELBARANG.RowSource = ""
Else
Me.TABELBARANG.RowSource = "DBBARANG!A6:E" & irow
End If
End Sub
ITEM HARI, BULAN DAN TAHUN
cbbulan.List = Array("Januari", "Februari", "Maret", "April", "Mei", "Juni",
"Juli", "Agustus", "September", "Oktober", "November", "Desember")
cbhari.List = Array("Senin", "Selasa", "Rabu", "Kamis", "Jumat", "Sabtu", "Minggu")
With cbtahun
For thn = 2020 To 2040
.AddItem thn
Next thn
End With
PENCARIAN
On Error GoTo Salah
Dim iRow As Long
Dim JData As Long
Dim CARI_DATA As Object
Set CARI_DATA = Sheet5
Sheet5.Range("J2").value = "Nama Pendidik"
Sheet5.Range("J3").value = "*" & Me.CARIPENDIDIK.value & "*"
CARI_DATA.Range("A2").CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CriteriaRange:= _
Sheet5.Range("J2:J3"), CopyToRange:=Sheet7.Range("A2:E2"), Unique:=False
iRow = Sheet7.Range("A" & Rows.Count).End(xlUp).Row
If Application.WorksheetFunction.CountA(Sheet7.Range("A3:A40000")) = 0 Then
Me.tbLaporan.RowSource = ""
Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")
Else
Me.tbLaporan.RowSource = "HASILFILTER!A3:E" & iRow
End If
jumlahkan1
Exit Sub
Salah:
Call MsgBox("Maaf Data tidak ditemukan", vbInformation, "Cari Data")
CETAK
Private Sub LCETAK_Click()
If Me.TXTSURAT.value = "" _
Or Me.ComboBox1.value = "" _
Or Me.TXTSATUAN.value = "" _
Or Me.TXTHARGASATUAN.value = "" _
Or Me.TXTJUMLAH.value = "" _
Or Me.TXTTOTAL.value = "" Then
Call MsgBox("Data Belum Lengkap !!!", vbInformation, "Cetak SPK")
Else
Sheet11.TextBox2.value = Me.TextBox1.value
Sheet11.TextBox3.value = Me.TextBox2.value
Sheet11.TextBox4.value = Me.TextBox2.value
Sheet11.TextBox5.value = Me.TextBox2.value
Select Case MsgBox("Anda akan mencetak Surat Perintah Kerja" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Cetak SPK")
Case vbNo
Exit Sub
Case vbYes
End Select
Application.Dialogs(xlDialogPrinterSetup).Show
Sheet11.PrintOut
End If
End Sub
Logout
ThisWorkbook.Save
MsgBox "Data Berhasil Disimpan", 64, "SUKSES"
Application.Quit
Unload Me
HIDEN CLOSE BUTTON
Option Explicit
Private Const GWL_STYLE = -16
Private Const WS_CAPTION = &HC00000
Private Const WS_SYSMENU = &H80000
Private Const SC_CLOSE = &HF060
#If VBA7 Then
Private Declare PtrSafe Function GetWindowLong _
Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLong _
Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, _
ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function DrawMenuBar _
Lib "user32" (ByVal hWnd As Long) As Long
Private Declare PtrSafe Function FindWindowA _
Lib "user32" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function DeleteMenu _
Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, _
ByVal wFlags As Long) As Long
Private Declare PtrSafe Function GetSystemMenu _
Lib "user32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
#Else
Private Declare Function GetWindowLong _
Lib "user32" Alias "GetWindowLongA" ( _
ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong _
Lib "user32" Alias "SetWindowLongA" ( _
ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar _
Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function FindWindowA _
Lib "user32" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function DeleteMenu _
Lib "user32" (ByVal hMenu As Long, _
ByVal nPosition As Long, ByVal wFlags As Long) As Long
Public Declare Function GetSystemMenu _
Lib "user32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
#End If
Public Sub SystemButtonSettings(frm As Object, show As Boolean)
Dim windowStyle As Long
Dim windowHandle As Long
windowHandle = FindWindowA(vbNullString, frm.Caption)
windowStyle = GetWindowLong(windowHandle, GWL_STYLE)
If show = False Then
SetWindowLong windowHandle, GWL_STYLE, (windowStyle And Not WS_SYSMENU)
Else
SetWindowLong windowHandle, GWL_STYLE, (windowStyle + WS_SYSMENU)
End If
DrawMenuBar (windowHandle)
End Sub
Public Sub CloseButtonSettings(frm As Object, show As Boolean)
Dim windowHandle As Long
Dim menuHandle As Long
windowHandle = FindWindowA(vbNullString, frm.Caption)
If show = True Then
menuHandle = GetSystemMenu(windowHandle, 1)
Else
menuHandle = GetSystemMenu(windowHandle, 0)
DeleteMenu menuHandle, SC_CLOSE, 0&
End If
End Sub
Private Sub UserForm_Initialize()
Call SystemButtonSettings(Me, False)
End Sub
