Form Penarikan

Option Explicit





Private Sub CBNISN_AfterUpdate()

End Sub

Private Sub CBNISN_Change()
On Error GoTo EXCELVBA
Dim CariSiswa As Object
Set CariSiswa = Sheet2.Range("B5:B1000000").Find(What:=Me.CBNISN.value, LookIn:=xlValues)
Me.TXTNAMASISWA.value = CariSiswa.Offset(0, 1).value
Me.TXTKELAS.value = CariSiswa.Offset(0, 3).value
Me.TXTSALDO.value = CariSiswa.Offset(0, 7).value

Exit Sub
EXCELVBA:
Call MsgBox("Maaf, NISN Santri belum terdaftar", vbInformation, "Data NISN")




End Sub

Private Sub cbnomorbaris_Change()
If cbnomorbaris.value < 1 Or cbnomorbaris.value > 28 Then
 MsgBox "Nomor baris melebihi batas buku tabungan" + vbCrLf + "Ulangi lagi!", vbInformation, "Info"
 cbnomorbaris.value = 1
 Else
 Sheets("CETAKTABUNGAN").Range("L7").value = cbnomorbaris.value + 1
 End If
End Sub

Private Sub CMDADD_Click()


'=============================================================
Dim DataPenarikan, UpdateSetoran As Object
Set DataPenarikan = Sheet5.Range("B1000000").End(xlUp)
Set UpdateSetoran = Sheet2.Range("B5:B1000000").Find(What:=Me.CBNISN.value, LookIn:=xlValues)

If Me.TXTIDTRANSAKSI.value = "" _
Or Me.TXTTANGGAL.value = "" _
Or Me.CBNISN.value = "" _
Or Me.TXTKEPERLUAN.value = "" _
Or Me.TXTPENARIKAN.value = "" Then
Call MsgBox("Harap isi data setoran dengan lengkap", vbInformation, "Setoran")
Else
DataPenarikan.Offset(1, -1).value = "=ROW()-ROW(PENARIKAN!$A$4)"
DataPenarikan.Offset(1, 0).value = Me.TXTIDTRANSAKSI.value
DataPenarikan.Offset(1, 1).value = Format(Me.TXTTANGGAL.value, "mm/dd/yyyy")
DataPenarikan.Offset(1, 2).value = Me.CBNISN.value
DataPenarikan.Offset(1, 3).value = Me.TXTNAMASISWA.value
DataPenarikan.Offset(1, 4).value = Me.TXTKELAS.value
DataPenarikan.Offset(1, 5).value = Me.TXTKEPERLUAN.value
DataPenarikan.Offset(1, 7).value = Me.TXTPENARIKAN.value

UpdateSetoran.Offset(0, 7).value = Me.TOTALSALDO.value
Call MsgBox("data setoran berhasil disimpan", vbInformation, "Setoran")
Me.TXTIDTRANSAKSI.value = ""
Me.TXTTANGGAL.value = ""
Me.CBNISN.value = ""
Me.TXTNAMASISWA.value = ""
Me.TXTKELAS.value = ""
Me.TXTKEPERLUAN.value = ""
Me.TXTPENARIKAN.value = ""
Me.TXTSALDO.value = ""
Me.TOTALSALDO.value = ""
Me.TXTTARIK.value = ""
Call AmbilData
End If
Me.lbltotaltarik.Caption = "Total Penarikan " & Format(Sheet1.Range("AC15").value, "Rp #,###")


Sheet1.Protect "1", userinterfaceonly:=True
End Sub

Private Sub CMDBARU_Click()
CMDUPDATE.Enabled = False
Dim X As Long
X = Sheet5.Range("K3").value + 1
Sheet5.Range("K3").value = X
If Sheet5.Range("K2").value = 1 Then
Me.TXTIDTRANSAKSI.value = "PN-100000" & X
End If
If Sheet5.Range("K2").value = 2 Then
Me.TXTIDTRANSAKSI.value = "PN-10000" & X
End If
If Sheet5.Range("K2").value = 3 Then
Me.TXTIDTRANSAKSI.value = "PN-1000" & X
End If
If Sheet5.Range("K2").value = 4 Then
Me.TXTIDTRANSAKSI.value = "PN-100" & X
End If
If Sheet5.Range("K2").value = 5 Then
Me.TXTIDTRANSAKSI.value = "PN-10" & X
End If
Me.TXTIDTRANSAKSI.Enabled = False

TXTTANGGAL.value = Format(Now(), "dd/mm/yyyy")
CBNISN.SetFocus

Sheet1.Protect "1", userinterfaceonly:=True
End Sub

Private Sub CMDCARI_Click()

On Error GoTo Salah
Dim iRow As Long
Dim JData As Long
Dim CARI_DATA As Object
Set CARI_DATA = Sheet5

Sheet7.Range("caripenarikanrange").Clear
Sheet7.Range("K4").value = Me.CBKRITERIA.value
Sheet7.Range("K5").value = "*" & Me.TXTCARI.value & "*"


CARI_DATA.Range("penarikanrangejudul").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Sheet7.Range("K4:K5"), CopyToRange:=Sheet7.Range("A4:I4"), Unique:=False



iRow = Sheet7.Range("A" & Rows.Count).End(xlUp).Row
If Application.WorksheetFunction.CountA(Sheet7.Range("A5:A1000000")) = 0 Then
Me.TABELDATA.RowSource = ""
Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")
Else
Me.TABELDATA.RowSource = "CARIPENARIKAN!A5:I" & iRow
End If
Me.TXTJUMLAH.value = Me.TABELDATA.ListCount
Me.lbltotaltarik.Caption = "Total Penarikan " & Format(Sheet7.Range("N4").value, "Rp #,###")
CMDPRINT.Visible = True
Exit Sub
Salah:
Call MsgBox("Maaf Data tidak ditemukan", vbInformation, "Cari Data")



Sheet1.Protect "1", userinterfaceonly:=True
End Sub

Private Sub CMDDELETE_Click()
Application.ScreenUpdating = False
Dim UpdateSaldo As Object
Set UpdateSaldo = Sheet2.Range("B4:B1000000").Find(What:=Me.CBNISN.value, LookIn:=xlValues)

If Me.TXTIDTRANSAKSI.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
Sheet5.Select

UpdateSaldo.Offset(0, 7).value = UpdateSaldo.Offset(0, 7).value + Val(Me.TXTTARIK.value)

Selection.EntireRow.Delete

Call MsgBox("Data berhasil dihapus", vbInformation, "Hapus Data")
Me.TXTIDTRANSAKSI.value = ""
Me.TXTTANGGAL.value = ""
Me.CBNISN.value = ""
Me.TXTNAMASISWA.value = ""
Me.TXTKELAS.value = ""
Me.TXTKEPERLUAN.value = ""
Me.TXTPENARIKAN.value = ""
Me.TXTSALDO.value = ""
Me.TOTALSALDO.value = ""
Me.TXTTARIK.value = ""
Call AmbilData
Sheet1.Select
End If
Sheet5.Range("M3").value = "=SUM($I$5:$I$1000000)"
Me.lbltotaltarik.Caption = "Total Penarikan " & Format(Sheet1.Range("AC15").value, "Rp #,###")


Sheet1.Protect "1", userinterfaceonly:=True
End Sub

Private Sub cmdprint_Click()
Dim cetak As Variant
cetak = MsgBox("Apakah anda yakin ingin mencetak?", vbQuestion + vbYesNo, "Cetak Laporan")
    If cetak = vbYes Then
    
           
            Sheet7.Select
                       
            '===proses cetak
            ActiveWindow.SelectedSheets.PrintOut from:=1, To:=100000, Copies:=1
            
            With Sheet7.PageSetup
            .Orientation = xlPortrait
            .LeftMargin = Application.CentimetersToPoints(0.5)
            .RightMargin = Application.CentimetersToPoints(0.5)
            .TopMargin = Application.CentimetersToPoints(2)
            .BottomMargin = Application.CentimetersToPoints(2)
            .Zoom = 90
            .PrintArea = "$A:$I"
            .PrintTitleRows = "$1:$4"
                        
            End With
            
            With Sheet7
            .Columns(1).ColumnWidth = 5 'nomor
            .Columns(2).ColumnWidth = 14.5 'kode transaksi
            .Columns(3).ColumnWidth = 11.5 'tanggal transaksi
            .Columns(4).ColumnWidth = 6.5 'nisn
            .Columns(5).ColumnWidth = 17 'nama santri
            .Columns(6).ColumnWidth = 8.5 'kelas
            .Columns(7).ColumnWidth = 22 'keterangan
            .Columns(8).ColumnWidth = 1 'setoran
            .Columns(9).ColumnWidth = 17 'penarikan
            
            
            End With
            Sheet1.Select
            MsgBox "Laporan berhasil dicetak", vbInformation, "Hasil Cetak"
       End If
    
   Sheet1.Protect "1", userinterfaceonly:=True
End Sub

Private Sub CMDRESET_Click()

Me.TXTIDTRANSAKSI.value = ""
Me.TXTTANGGAL.value = ""
Me.CBNISN.value = ""
Me.TXTNAMASISWA.value = ""
Me.TXTKELAS.value = ""
Me.TXTKEPERLUAN.value = ""
Me.TXTPENARIKAN.value = ""
Me.TXTSALDO.value = ""
Me.TOTALSALDO.value = ""
Me.TXTTARIK.value = ""
Me.CBKRITERIA.value = ""
Me.TXTCARI.value = ""
Me.TXTTARIK.value = ""

Me.CMDADD.Enabled = True
Me.CMDBARU.Enabled = True
Call AmbilData

Me.lbltotaltarik.Caption = "Total Penarikan " & Format(Sheet1.Range("AC15").value, "Rp #,###")


Sheet1.Protect "1", userinterfaceonly:=True
End Sub

Private Sub CMDUPDATE_Click()




Application.ScreenUpdating = False
If TXTPENARIKAN.value > TXTSALDO.value Or TXTSALDO.value = "" Then
MsgBox "Saldo Tidak cukup" & vbCrLf & "Silahkan cek saldo santri", vbCritical + vbOKOnly, "Saldo Tidak Cukup"
TXTPENARIKAN.value = ""

End If
TXTPENARIKAN.SetFocus



'Perintah membuat Sumber data yang diubah
Dim UBAHDATA As Object
Dim UpdateSaldo As Object
Set UBAHDATA = Sheet5.Range("B5:B1000000").Find(What:=Me.TXTIDTRANSAKSI.value, LookIn:=xlValues)
Set UpdateSaldo = Sheet2.Range("B5:B1000000").Find(What:=Me.CBNISN.value, LookIn:=xlValues)

'Perintah mengecek apakah ada data yang diubah
If Me.TXTIDTRANSAKSI.value = "" Then
Call MsgBox("Untuk mengubah Data, Pilih data terlebih dahulu", vbInformation, "Ubah Data")
Else

'Perintah mengubah data dari kolom pertama
UBAHDATA.Offset(0, 1).value = Format(Me.TXTTANGGAL.value, "mm/dd/yyyy")

UBAHDATA.Offset(0, 5).value = Me.TXTKEPERLUAN.value
UBAHDATA.Offset(0, 7).value = Me.TXTPENARIKAN.value
UpdateSaldo.Offset(0, 7).value = Me.TOTALSALDO.value
'Perintah memunculkan pesan bahwa data berhasil diubah
Call MsgBox("Data berhasil diubah", vbInformation, "Ubah Data")

'Perintah membersihkan textbox
Me.TXTIDTRANSAKSI.value = ""
Me.TXTTANGGAL.value = ""
Me.CBNISN.value = ""
Me.TXTNAMASISWA.value = ""
Me.TXTKELAS.value = ""
Me.TXTKEPERLUAN.value = ""
Me.TXTPENARIKAN.value = ""
Me.TXTSALDO.value = ""
Me.TOTALSALDO.value = ""
Me.TXTTARIK.value = ""

Call AmbilData
Sheet1.Select
End If


Me.lbltotaltarik.Caption = "Total Penarikan " & Format(Sheet1.Range("AC15").value, "Rp #,###")


Sheet1.Protect "1", userinterfaceonly:=True
End Sub





Private Sub gambartgl_Click()
Dim dateVariable As Date
dateVariable = CalendarForm.GetDate
If dateVariable <> 0 Then TXTTANGGAL = Format(dateVariable, "dd/mm/yyyy")
End Sub

Private Sub printtabungan_Click()

Dim baris As Byte
Dim cetak As Variant

Application.ScreenUpdating = False
Me.TABELDATA.value = ""

If Me.cbnomorbaris.value = "" Or Me.TXTIDTRANSAKSI.value = "" Then
Call MsgBox("Masukkan nomor baris dahulu baru Pilih data yang akan dicetak !", vbInformation, "Cetak Tabungan")
Else
cetak = MsgBox("Pastikan buku bank, sudah dimasukkan di printer !" + vbCrLf + _
"Apakah anda ingin melanjutkan cetak??", vbQuestion + vbYesNo, "Cetak Buku Tabungan")
    If cetak = vbYes Then
    
            Sheet12.Range("areacetaktabungan").ClearContents
            Sheet5.Select
            Call cetaktabunganpenarikan
            
            '########################################
            '===proses cetak di buku tabungan
            ActiveWindow.SelectedSheets.PrintOut from:=1, To:=1, Copies:=1
            
            With Sheet12.PageSetup
            .Orientation = xlPortrait
            .LeftMargin = Application.CentimetersToPoints(0)
            .RightMargin = Application.CentimetersToPoints(0.2)
            .TopMargin = Application.CentimetersToPoints(1.3)
            .BottomMargin = Application.CentimetersToPoints(1.3)
            .Zoom = 87
            .PrintArea = "$A$2:$G$29"
            End With
            
            With Sheet12
            .Columns(1).ColumnWidth = 3
            .Columns(2).ColumnWidth = 11
            .Columns(3).ColumnWidth = 3.43
            .Columns(4).ColumnWidth = 14
            .Columns(5).ColumnWidth = 14
            .Columns(6).ColumnWidth = 14
            .Columns(7).ColumnWidth = 4.57
            End With
            Sheet1.Select
            MsgBox "Transaksi Penarikan santri berhasil dicetak", vbInformation, "Cetak Penarikan"
       End If
    
End If

Sheet1.Protect "1", userinterfaceonly:=True
End Sub

Private Sub TABELDATA_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

On Error GoTo EXCELVBA
Dim SUMBERUBAH, CELLAKTIF As String
Application.ScreenUpdating = False

Me.TXTIDTRANSAKSI.value = Me.TABELDATA.Column(1)
Me.TXTTANGGAL.value = Format(Me.TABELDATA.Column(2), "dd/mm/yyyy")
Me.CBNISN.value = Me.TABELDATA.Column(3)
Me.TXTNAMASISWA.value = Me.TABELDATA.Column(4)
Me.TXTKELAS.value = Me.TABELDATA.Column(5)
Me.TXTKEPERLUAN.value = Me.TABELDATA.Column(6)
Me.TXTPENARIKAN.value = Me.TABELDATA.Column(8)
Me.TOTALSALDO.value = Me.TXTSALDO.value
Me.TXTTARIK.value = Me.TXTPENARIKAN.value
Sheet5.Select
SUMBERUBAH = Sheets("PENARIKAN").Cells(Rows.Count, "B").End(xlUp).Row
Sheets("PENARIKAN").Range("B5:B" & SUMBERUBAH).Find(What:=Me.TXTIDTRANSAKSI.value, LookIn:=xlValues, LookAt:=xlWhole).Activate
CELLAKTIF = ActiveCell.Row
Sheets("PENARIKAN").Range("A" & CELLAKTIF & ":I" & CELLAKTIF).Select
Sheet1.Select
Me.CMDADD.Enabled = False
Me.CMDBARU.Enabled = False
Me.CMDUPDATE.Enabled = True
Exit Sub
EXCELVBA:
Call MsgBox("Klik 2x pada tabel data", vbInformation, "Pilih Data")

End Sub





Private Sub TXTPENARIKAN_Change()

On Error Resume Next


Me.TOTALSALDO.value = Val(Me.TXTSALDO.value) + Val(Me.TXTTARIK.value) - Val(Me.TXTPENARIKAN.value)

If Val(Me.TXTPENARIKAN.value) > Val(Me.TXTSALDO.value) Then
MsgBox "Saldo Tidak cukup" & vbCrLf & "Silahkan cek saldo santri", vbCritical + vbOKOnly, "Saldo Tidak Cukup"
Me.TXTPENARIKAN.value = ""
End If



TXTPENARIKAN.SetFocus


End Sub





Private Sub TXTPENARIKAN_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
    Case Asc("0") To Asc("9")
    Case Else
        KeyAscii = 0
End Select
End Sub

Private Sub UserForm_Activate()
Dim berhenti As Boolean
berhenti = False
Do Until berhenti
    lbljam.Caption = " | Pukul : " & Format(Time, "hh:mm:ss") & " WIB"
    DoEvents
Loop
End Sub

Private Sub UserForm_Initialize()
lbltg.Caption = Format(Now(), "dddd, dd mmmm yyyy")
Call AmbilNISN
Call AmbilData
With CBKRITERIA
.AddItem "NISN"
.AddItem "Nama Santri"
.AddItem "Kelas"
End With

With cbnomorbaris
.AddItem "1"
.AddItem "2"
.AddItem "3"
.AddItem "4"
.AddItem "5"
.AddItem "6"
.AddItem "7"
.AddItem "8"
.AddItem "9"
.AddItem "10"
.AddItem "11"
.AddItem "12"
.AddItem "13"
.AddItem "14"
.AddItem "15"
.AddItem "16"
.AddItem "17"
.AddItem "18"
.AddItem "19"
.AddItem "20"
.AddItem "21"
.AddItem "22"
.AddItem "23"
.AddItem "24"
.AddItem "25"
.AddItem "26"
.AddItem "27"
.AddItem "28"
End With





TABELDATA.ColumnWidths = "30,80,70,50,100,70,150,1,100"

If Sheet5.Range("A5").value = "" Then
Me.lbltotaltarik.Caption = ""
Else
Me.lbltotaltarik.Caption = "Total Penarikan " & Format(Sheet1.Range("AC15").value, "Rp #,###")
End If


CMDPRINT.Visible = False
End Sub
Private Sub AmbilNISN()
Dim TData As Long
Dim iRow As Long
Sheet2.Select
iRow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
TData = Application.WorksheetFunction.CountA(Sheet2.Range("B5:B1000000"))
If TData = 0 Then
Me.CBNISN.RowSource = ""
Else
Me.CBNISN.RowSource = "DATASISWA!B5:C" & iRow
End If
End Sub
Private Sub AmbilData()
Application.ScreenUpdating = False
Dim TData As Long
Dim iRow As Long
Sheet5.Select
iRow = Sheet5.Range("A" & Rows.Count).End(xlUp).Row
TData = Application.WorksheetFunction.CountA(Sheet5.Range("B5:B1000000"))
If TData = 0 Then
Me.TABELDATA.RowSource = ""
Else
Me.TABELDATA.RowSource = "PENARIKAN!A5:I" & iRow
Me.TXTJUMLAH.value = Me.TABELDATA.ListCount
End If
Sheet1.Select
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Dim berhenti As Boolean
berhenti = True
Unload Me
End
End Sub