Minggu, 28 November 2021

Form Setoran 

Option Explicit





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



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 cbnomorbaris_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 CMDADD_Click()

Dim DataSetoran, UpdateSetoran As Object
Set DataSetoran = Sheet4.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.TXTSETORAN.value = "" Then
Call MsgBox("Harap isi data setoran dengan lengkap", vbInformation, "Setoran")
Else
DataSetoran.Offset(1, -1).value = "=ROW()-ROW(SETORAN!$A$4)"
DataSetoran.Offset(1, 0).value = Me.TXTIDTRANSAKSI.value
DataSetoran.Offset(1, 1).value = Format(Me.TXTTANGGAL.value, "mm/dd/yyyy")
DataSetoran.Offset(1, 2).value = Me.CBNISN.value
DataSetoran.Offset(1, 3).value = Me.TXTNAMASISWA.value
DataSetoran.Offset(1, 4).value = Me.TXTKELAS.value
DataSetoran.Offset(1, 5).value = Me.TXTKEPERLUAN.value
DataSetoran.Offset(1, 6).value = Me.TXTSETORAN.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.TXTSETORAN.value = ""
Me.TXTSALDO.value = ""
Me.TOTALSALDO.value = ""
Call AmbilData
End If

Me.lbltotalnama.Caption = "Total Setoran " & Format(Sheet1.Range("AB15").value, "Rp #,###")

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

Private Sub CMDBARU_Click()

Dim X As Long
X = Sheet4.Range("K3").value + 1
Sheet4.Range("K3").value = X
If Sheet4.Range("K2").value = 1 Then
Me.TXTIDTRANSAKSI.value = "ST-100000" & X
End If
If Sheet4.Range("K2").value = 2 Then
Me.TXTIDTRANSAKSI.value = "ST-10000" & X
End If
If Sheet4.Range("K2").value = 3 Then
Me.TXTIDTRANSAKSI.value = "ST-1000" & X
End If
If Sheet4.Range("K2").value = 4 Then
Me.TXTIDTRANSAKSI.value = "ST-100" & X
End If
If Sheet4.Range("K2").value = 5 Then
Me.TXTIDTRANSAKSI.value = "ST-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 = Sheet4
Sheet3.Range("carisetoranrange").Clear

Sheet3.Range("K4").value = Me.CBKRITERIA.value
Sheet3.Range("K5").value = "*" & Me.TXTCARI.value & "*"


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


iRow = Sheet3.Range("A" & Rows.Count).End(xlUp).Row
If Application.WorksheetFunction.CountA(Sheet3.Range("A5:A1000000")) = 0 Then
Me.TABELDATA.RowSource = ""
Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")
Else
Me.TABELDATA.RowSource = "CARISETORAN!A5:H" & iRow
End If
Me.TXTJUMLAH.value = Me.TABELDATA.ListCount


Me.lbltotalnama.Caption = "Total Setoran " & Format(Sheet3.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
Sheet4.Select

UpdateSaldo.Offset(0, 7).value = UpdateSaldo.Offset(0, 7).value - Me.TXTSETOR.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.TXTSETORAN.value = ""
Me.TXTSALDO.value = ""
Me.TOTALSALDO.value = ""

Call AmbilData
Sheet1.Select
End If
Sheet4.Range("M3").value = "=SUM($H$5:$H$1000000)"
Me.lbltotalnama.Caption = "Total Setoran " & Format(Sheet1.Range("AB15").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
    
           
            Sheet3.Select
                       
            '===proses cetak
            ActiveWindow.SelectedSheets.PrintOut from:=1, To:=100000, Copies:=1
            
            With Sheet3.PageSetup
            .Orientation = xlPortrait
            .LeftMargin = Application.CentimetersToPoints(0.5)
            .RightMargin = Application.CentimetersToPoints(0.5)
            .TopMargin = Application.CentimetersToPoints(2)
            .BottomMargin = Application.CentimetersToPoints(2)
            .Zoom = 90
            .PrintTitleRows = "$1:$4"
            .PrintArea = "$A:$H"
            
                        
            End With
            
            With Sheet3
            .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 = 17 'setoran
            
            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.TXTSETORAN.value = ""
Me.TXTSALDO.value = ""
Me.TOTALSALDO.value = ""
Me.TXTSETOR.value = ""
Me.CBKRITERIA.value = ""
Me.TXTCARI.value = ""
Me.CMDADD.Enabled = True
Me.CMDBARU.Enabled = True
Call AmbilData

Me.lbltotalnama.Caption = "Total Setoran " & Format(Sheet1.Range("AB15").value, "Rp #,###")

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

Private Sub CMDUPDATE_Click()
Application.ScreenUpdating = False
'Perintah membuat Sumber data yang diubah
Dim UBAHDATA As Object
Dim UpdateSaldo As Object
Set UBAHDATA = Sheet4.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, 6).value = Me.TXTSETORAN.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.TXTSETORAN.value = ""
Me.TXTSALDO.value = ""
Me.TOTALSALDO.value = ""

Call AmbilData
Sheet1.Select
End If


Me.lbltotalnama.Caption = "Total Setoran " & Format(Sheet1.Range("AB15").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
            Sheet4.Select
            Call cetaktabungansetoran
            
            '########################################
            '===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 Setoran santri berhasil dicetak", vbInformation, "Cetak Setoran"
       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.TXTSETORAN.value = Me.TABELDATA.Column(7)
Me.TOTALSALDO.value = Me.TXTSALDO.value
Me.TXTSETOR.value = Me.TXTSETORAN.value
Sheet4.Select
SUMBERUBAH = Sheets("SETORAN").Cells(Rows.Count, "B").End(xlUp).Row
Sheets("SETORAN").Range("B5:B" & SUMBERUBAH).Find(What:=Me.TXTIDTRANSAKSI.value, LookIn:=xlValues, LookAt:=xlWhole).Activate
CELLAKTIF = ActiveCell.Row
Sheets("SETORAN").Range("A" & CELLAKTIF & ":H" & CELLAKTIF).Select
Sheet1.Select
Me.CMDADD.Enabled = False
Me.CMDBARU.Enabled = False
Exit Sub
EXCELVBA:
Call MsgBox("Klik 2x pada tabel data", vbInformation, "Pilih Data")

Me.lbltotalnama.Caption = "Total Setoran " & Format(Sheet1.Range("AB15").value, "Rp #,###")
End Sub



Private Sub txtnomorbaris_Change()
Sheets("CETAKTABUNGAN").Range("L7") = txtnomorbaris.value
End Sub

Private Sub TXTSETORAN_Change()

On Error Resume Next

Me.TOTALSALDO.value = Val(Me.TXTSALDO.value) - Val(Me.TXTSETOR.value) + Val(Me.TXTSETORAN.value)


End Sub


Private Sub TXTSETORAN_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



If Sheet4.Range("A5").value = "" Then
Me.lbltotalnama.Caption = ""
Else
Me.lbltotalnama.Caption = "Total Setoran " & Format(Sheet1.Range("AB15").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:B10000"))
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
Sheet4.Select
iRow = Sheet4.Range("A" & Rows.Count).End(xlUp).Row
TData = Application.WorksheetFunction.CountA(Sheet4.Range("B5:B10000"))
If TData = 0 Then
Me.TABELDATA.RowSource = ""
Else
Me.TABELDATA.RowSource = "SETORAN!A5:H" & 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
Sheet1.Protect "1", userinterfaceonly:=True
Unload Me

End

End Sub
di
Label:

Tidak ada komentar:

Posting Komentar

Langganan: Posting Komentar (Atom)

Menghitung USIA Excel

=BYROW(D2:D100; LAMBDA(tanggal_lahir;     IF(tanggal_lahir=""; "";         DATEDIF(tanggal_lahir; TODAY(); "y"...