Private Sub CMDRESETALL_Click()
Dim pesan As Variant
pesan = MsgBox("Apakah anda yakin ingin mereset data?" + vbCrLf + _
"Tindakan ini menyebabkan seluruh data santri, data setoran dan data penarikan akan dihapus semuanya", vbQuestion + vbOKCancel, "Reset Data")
If pesan = vbOK Then
Sheet2.Range("A5") = 1
Sheet4.Range("A5") = 1
Sheet4.Range("K3") = 0
Sheet5.Range("A5") = 1
Sheet5.Range("K3") = 0
Sheet2.Range("datasiswatanpajudul").ClearContents
Sheet4.Range("datasetorantanpajudul").ClearContents
Sheet5.Range("datapenarikantanpajudul").ClearContents
Sheet2.Range("A5") = 1
Sheet4.Range("A5") = 1
Sheet4.Range("K3") = 0
Sheet5.Range("A5") = 1
Sheet5.Range("K3") = 0
MsgBox "Seluruh data berhasil dihapus", vbInformation, "Reset Data"
Else
Exit Sub
End If
End Sub
Private Sub Worksheet_Activate()
ActiveWindow.DisplayHeadings = False
ActiveWindow.View = xlNormalView
ActiveWindow.DisplayGridlines = False
ActiveWindow.DisplayHeadings = False
ActiveWindow.DisplayWorkbookTabs = True
ActiveWindow.Zoom = 100
End Sub
Minggu, 28 November 2021
Worksheet MENU
Workbook Tabungan
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Select Case MsgBox("Apakah anda ingin menyimpan file ini?", vbYesNo + vbQuestion, "Informasi")
Case Is = vbNo
Application.Quit
Exit Sub
Case Is = vbYes
ThisWorkbook.Save
Application.Quit
End Select
End Sub
Private Sub Workbook_Open()
Sheet1.Protect "1", userinterfaceonly:=True
Sheet1.Select
With Application
.Caption = " | created By @qil"
.ExecuteExcel4Macro "Show.ToolBar(""Ribbon"",true)"
End With
ActiveWindow.DisplayWorkbookTabs = True
End Sub
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Cancel = True
MsgBox "Maaf klik kanan dinonaktifkan", vbOKOnly + vbInformation, "Informasi"
End Sub
Modul User_name
Option Explicit
Sub user()
Application.ScreenUpdating = False
Dim a, b As String
a = InputBox("Masukkan nama Lengkap", "UserName")
b = InputBox("Masukkan Initial nama ( 3-4 huruf)", "Initial")
Sheets("MENU").Range("$Z$24").value = a
Sheets("MENU").Range("$Z$26").value = b
MsgBox "Penambahan Username Berhasil", vbInformation, "Informasi"
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Modul Urutkan_Hasil
Option Explicit
Sub urut3()
'===========mengurutkan berdasarkan tanggal==============
ActiveWorkbook.Sheets("CARIGABUNG1").Range("carigabung1range").Select
ActiveWorkbook.Sheets("CARIGABUNG1").Sort.SortFields.Clear
ActiveWorkbook.Sheets("CARIGABUNG1").Sort.SortFields.Add Key:=Range("tanggalcarigabung1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Sheets("CARIGABUNG1").Sort
.SetRange Range("carigabung1range")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheet9.Select
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Sub urut1()
'===========mengurutkan berdasarkan tanggal==============
ActiveWorkbook.Sheets("CARIGABUNG2").Range("carigabung2range").Select
ActiveWorkbook.Sheets("CARIGABUNG2").Sort.SortFields.Clear
ActiveWorkbook.Sheets("CARIGABUNG2").Sort.SortFields.Add Key:=Range("tanggalcarigabung2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Sheets("CARIGABUNG2").Sort
.SetRange Range("carigabung2range")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheet10.Select
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Modul Setting_printer
Option Explicit
Sub setting_printer()
'Application.Dialogs(xlDialogPrint).Show
'Application.Dialogs(xlDialogPrinterSetup).Show
'Sheet11.Select
Application.SendKeys ("^p")
'Sheet1.PrintPreview
'Application.Dialogs(xlDialogPageSetup).Show
Sheet1.Select
End Sub
Modul Menu
Sub bukalaporansantri()
Sheet1.Unprotect "1"
FORMLAPORANSANTRI.Show
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Sub BukaDataSiswa()
Sheet1.Unprotect "1"
FORMSISWA.Show
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Sub BukaSetoran()
Sheet1.Unprotect "1"
FORMSETORAN.Show
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Sub BukaPenarikan()
Sheet1.Unprotect "1"
FORMPENARIKAN.Show
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Sub Laporan()
Sheet1.Unprotect "1"
FORMLAPORAN.Show
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Sub LaporanSantri()
Sheet1.Unprotect "1"
FORMLAPORANSANTRI.Show
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Sub Simpan()
ThisWorkbook.Save
End Sub
Sub Keluar()
Select Case MsgBox("Anda akan keluar dari Aplikasi" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Keluar")
Case vbNo
Exit Sub
Case vbYes
End Select
ThisWorkbook.Save
ThisWorkbook.Close
End Sub
Modul Hapus_Akun
Sub hapusakun()
Dim rujukan As Range
Set rujukan = Sheets("SETORAN").Range("$O$2")
'===pencarian nomor induk===
rujukan.ClearContents
'Sheets("DATASISWA").Select
Selection.EntireRow.Select
Selection.Columns(2).Select
Selection.Copy
rujukan.PasteSpecial Paste:=xlPasteValues
'===proses hapus DATASISWA sesuai induk===
Dim jumlahsiswa, jumlahsetoran, jumlahpenarikan As Long
Dim baris As Long
On Error Resume Next
jumlahsiswa = Sheets("DATASISWA").Range("nisndatasiswa").Rows.Count
jumlahsetoran = Sheets("SETORAN").Range("nisnsetoran").Rows.Count
jumlahpenarikan = Sheets("PENARIKAN").Range("nisnpenarikan").Rows.Count
For baris = 5 To jumlahsiswa + 4
Sheets("DATASISWA").Cells(baris, 2).Select
If Selection.value = rujukan.value Then
Selection.EntireRow.Delete
End If
Next baris
Sheet2.Range("I2").value = "=SUM($I$5:$I$1000000)"
'===proses hapus SETORAN sesuai induk===
Sheets("SETORAN").Select
For baris = 5 To jumlahsetoran + 4
Sheets("SETORAN").Cells(baris, 4).Select
If Selection.value = rujukan.value Then
Selection.EntireRow.ClearContents
End If
Next baris
'=====hapus setoran yang sudah kosong=
Dim c As Long
c = Cells(Rows.Count, 1).End(xlUp).Row
Sheets("SETORAN").Range("A5:A" & c).Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
'===============================
Sheet4.Range("M3").value = "=SUM($H$5:$H$1000000)"
'===proses hapus PENARIKAN sesuai induk===
Sheets("PENARIKAN").Select
For baris = 5 To jumlahpenarikan + 4
Sheets("PENARIKAN").Cells(baris, 4).Select
If Selection.value = rujukan.value Then
Selection.EntireRow.ClearContents
End If
Next baris
'=====hapus penarikan yang sudah kosong=
c = Cells(Rows.Count, 1).End(xlUp).Row
Sheets("PENARIKAN").Range("A5:A" & c).Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
'===============================
Sheet5.Range("M3").value = "=SUM($I$5:$I$1000000)"
Sheet2.Range("A5") = 1
Sheet4.Range("A5") = 1
Sheet5.Range("A5") = 1
MsgBox "Data akun santri berhasil dihapus", vbInformation, "Hapus Akun"
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Modul Cetak_Tab_Setoran
Option Explicit
Sub cetaktabungansetoran()
Dim rujukan As Range
Dim b As Long
Set rujukan = Sheets("CETAKTABUNGAN").Range("$O$2")
'===proses copy data setoran yang terpilih==
Selection.EntireRow.Select
ActiveCell.Select
b = ActiveCell.Row
Range("B" & b & ":I" & b).Select
Selection.Copy Sheet3.Range("B5")
Sheets("CARISETORAN").Select
'=====membuat nomor urut otomatis==============
Dim i As Long
Dim X As Long
Dim no As Long
Dim cell As Variant
X = Sheet3.Range("B" & Rows.Count).End(xlUp).Row
no = 0
For i = 1 To X - 4
no = no + 1
Cells(i + 4, 1).value = no
Next i
Sheets("CETAKTABUNGAN").Select
Dim nobaris As Byte
nobaris = Sheets("CETAKTABUNGAN").Range("L7").value
'===memasukkan nilai ke sheet CETAKTABUNGAN
Range("B" & nobaris).value = Sheet3.Range("C5").value
Range("C" & nobaris).value = Sheet3.Range("D5").value
Range("D" & nobaris).value = Sheet3.Range("H5").value
Dim jumlahsiswa As Long
Dim baris As Long
On Error Resume Next
jumlahsiswa = Sheets("DATASISWA").Range("nisndatasiswa").Rows.Count
Sheet2.Select
For baris = 5 To jumlahsiswa + 4
Sheets("DATASISWA").Cells(baris, 2).Select
If Selection.value = rujukan.value Then
Selection.Row.Select
b = Selection.Row
Sheets("DATASISWA").Range("I" & b).Select
Exit For
End If
Next baris
Sheets("CETAKTABUNGAN").Range("F" & nobaris).value = Selection.value
Sheets("CETAKTABUNGAN").Range("A" & nobaris).value = "=Row() - 1"
Sheets("CETAKTABUNGAN").Range("G" & nobaris).value = Sheet1.Range("Z26").value
Sheet12.Select
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Modul Cetak_Tab_Penarikan
Option Explicit
Sub cetaktabunganpenarikan()
Dim rujukan As Range
Dim b As Long
Set rujukan = Sheets("CETAKTABUNGAN").Range("P2")
'===proses copy data setoran yang terpilih==
Selection.EntireRow.Select
ActiveCell.Select
b = ActiveCell.Row
Range("B" & b & ":I" & b).Select
Selection.Copy Sheet7.Range("B5")
Sheets("CARIPENARIKAN").Select
'=====membuat nomor urut otomatis==============
Dim i As Long
Dim X As Long
Dim no As Long
Dim cell As Variant
X = Sheet7.Range("B" & Rows.Count).End(xlUp).Row
no = 0
For i = 1 To X - 4
no = no + 1
Cells(i + 4, 1).value = no
Next i
Sheets("CETAKTABUNGAN").Select
Dim nobaris As Byte
nobaris = Sheets("CETAKTABUNGAN").Range("L7").value
'===memasukkan nilai ke sheet CETAKTABUNGAN
Range("B" & nobaris).value = Sheet7.Range("C5").value
Range("C" & nobaris).value = Sheet7.Range("D5").value
Range("E" & nobaris).value = Sheet7.Range("I5").value
Dim jumlahsiswa As Long
Dim baris As Long
On Error Resume Next
jumlahsiswa = Sheets("DATASISWA").Range("nisndatasiswa").Rows.Count
Sheet2.Select
For baris = 5 To jumlahsiswa + 4
Sheets("DATASISWA").Cells(baris, 2).Select
If Selection.value = rujukan.value Then
Selection.Row.Select
b = Selection.Row
Sheets("DATASISWA").Range("I" & b).Select
Exit For
End If
Next baris
Sheets("CETAKTABUNGAN").Range("F" & nobaris).value = Selection.value
Sheets("CETAKTABUNGAN").Range("A" & nobaris).value = "=Row() - 1"
Sheets("CETAKTABUNGAN").Range("G" & nobaris).value = Sheet1.Range("Z26").value
Sheet12.Select
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Modul Cetak_Tab_Identitas_Santri
Sub cetakidentitassantri()
Dim rujukan As Range
Dim b As Long
Set rujukan = Sheets("CETAKIDENTITAS").Range("$H$2")
'===proses copy data dari Sheet DATASISWA yang terpilih==
Selection.EntireRow.Select
ActiveCell.Select
b = ActiveCell.Row
Range("B" & b & ":I" & b).Select
Selection.Copy Sheet6.Range("B6")
Sheets("CARISISWA").Select
'=====membuat nomor urut otomatis==============
Dim i As Long
Dim X As Long
Dim no As Long
Dim cell As Variant
X = Sheet6.Range("B" & Rows.Count).End(xlUp).Row
no = 0
For i = 1 To X - 5
no = no + 1
Cells(i + 5, 1).value = no
Next i
Sheets("CETAKIDENTITAS").Select
Dim nobaris As Byte
'===memasukkan nilai ke sheet CETAKTABUNGAN
Range("B1").value = Sheet6.Range("B6").value
Range("B2").value = Sheet6.Range("C6").value
Range("B3").value = Sheet6.Range("D6").value
Range("C6").value = Sheet6.Range("E6").value
Range("C7").value = Sheet6.Range("G6").value
Range("E6").value = Sheet6.Range("H6").value
Sheet14.Select
'MsgBox "Data akun santri berhasil dihapus", vbInformation, "Hapus Akun"
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Modul Cetak_Laporan_Santri
Option Explicit
Private Sub hasilpencariangabung()
Dim gabung As Range
Set gabung = Sheet8.Range("A4")
gabung.CurrentRegion.Clear
Sheet4.Range("setoranrange").Copy Sheet8.Range("A4:I4")
Dim iRow As Long
iRow = Sheet8.Range("A" & Rows.Count).End(xlUp).Row
Sheet5.Range("penarikanrange").Copy Sheet8.Range("A" & iRow + 1)
'Sheet8.Select
'Sheet9.Select
'####################################################
On Error GoTo Salah
Dim iRow2 As Long
Dim JData As Long
Dim CARI_DATA As Object
Set CARI_DATA = Sheet8
Sheet9.Range("L4").value = "Tanggal"
Sheet9.Range("M4").value = "Tanggal"
Sheet9.Range("L5").value = ">=" & Format(Me.TGLAWAL1.value, "mm/dd/yyyy")
Sheet9.Range("M5").value = "<=" & Format(Me.TGLAKHIR1.value, "mm/dd/yyyy")
Sheet9.Range("A6").CurrentRegion.Clear
CARI_DATA.Range("A4").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Sheet9.Range("L4:M5"), CopyToRange:=Sheet9.Range("A6:I6"), Unique:=False
Dim i As Long
Dim X As Long
Dim no As Long
X = Sheet9.Range("B" & Rows.Count).End(xlUp).Row
no = 0
For i = 1 To X - 6
no = no + 1
Cells(i + 6, 1).value = no
Next i
Salah:
Call MsgBox("Maaf Data tidak ditemukan", vbInformation, "Cari Data")
End Sub
Form Laporan (Bawa'an)
Option Explicit
Private Sub CariSetoran()
On Error GoTo Salah
Dim iRow As Long
Dim JData As Long
Dim CARI_DATA As Object
Set CARI_DATA = Sheet4
Sheet3.Range("K4").value = "Tanggal"
Sheet3.Range("L4").value = "Tanggal"
Sheet3.Range("K5").value = ">=" & Format(Me.TGLAWAL.value, "mm/dd/yyyy")
Sheet3.Range("L5").value = "<=" & Format(Me.TGLAKHIR.value, "mm/dd/yyyy")
CARI_DATA.Range("A4").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Sheet3.Range("K4:L5"), 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:I" & iRow
End If
Exit Sub
Salah:
Call MsgBox("Maaf Data tidak ditemukan", vbInformation, "Cari Data")
End Sub
Private Sub CariPenarikan()
On Error GoTo Salah
Dim iRow As Long
Dim JData As Long
Dim CARI_DATA As Object
Set CARI_DATA = Sheet5
Sheet7.Range("K4").value = "Tanggal"
Sheet7.Range("L4").value = "Tanggal"
Sheet7.Range("K5").value = ">=" & Format(Me.TGLAWAL.value, "mm/dd/yyyy")
Sheet7.Range("L5").value = "<=" & Format(Me.TGLAKHIR.value, "mm/dd/yyyy")
CARI_DATA.Range("penarikanrangejudul").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Sheet7.Range("K4:L5"), 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
Exit Sub
Salah:
Call MsgBox("Maaf Data tidak ditemukan", vbInformation, "Cari Data")
End Sub
Private Sub CMDCARI_Click()
If Me.SETORAN.value = False And Me.PENARIKAN.value = False Then
MsgBox "Anda belum memilih pilihan Setoran atau Penarikan" + vbCrLf + "Silahkan dipilih terlebih dahulu", vbInformation + vbOKOnly, "Belum Memilih"
End If
If Me.PENARIKAN.value = True Then
Me.SETORAN.value = False
Call CariPenarikan
TABELDATA.ColumnWidths = "30,80,70,50,100,40,150,1,100"
Me.TOTALDATA.value = Me.TABELDATA.ListCount
Me.TOTALNILAI.value = Sheet7.Range("N4").value
If Sheet7.Range("E2").value = 0 Then
Me.lbltotalnama.Caption = ""
Else
Me.lbltotalnama.Caption = "Total Penarikan " & Format(Sheet7.Range("E2").value, "Rp #,###")
End If
End If
If Me.SETORAN.value = True Then
Me.PENARIKAN.value = False
Call CariSetoran
TABELDATA.ColumnWidths = "30,80,70,50,100,40,150,100,1"
Me.TOTALDATA.value = Me.TABELDATA.ListCount
Me.TOTALNILAI.value = Sheet3.Range("N4").value
If Sheet3.Range("E2").value = 0 Then
Me.lbltotalnama.Caption = ""
Else
Me.lbltotalnama.Caption = "Total Setoran " & Format(Sheet3.Range("E2").value, "Rp #,###")
End If
End If
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Private Sub cmdprint_Click()
If Me.SETORAN.value = True Then
Select Case MsgBox("Anda akan mencetak data" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Cetak Setoran")
Case vbNo
Exit Sub
Case vbYes
End Select
'#################################################################
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
.PrintArea = "$A:$I"
.PrintTitleRows = "$1:$4"
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
.Columns(9).ColumnWidth = 1 'penarikan
End With
Sheet1.Select
MsgBox "Laporan berhasil dicetak", vbInformation, "Hasil Cetak"
End If
'Unload Me
'Sheet3.PrintPreview
'FORMLAPORAN.Show
End If
If Me.PENARIKAN.value = True Then
Select Case MsgBox("Anda akan mencetak data" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Cetak Setoran")
Case vbNo
Exit Sub
Case vbYes
End Select
'##########################################################
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 'penarikan
.Columns(9).ColumnWidth = 17 'penarikan
End With
Sheet1.Select
MsgBox "Laporan berhasil dicetak", vbInformation, "Hasil Cetak"
End If
'Unload Me
'Sheet7.PrintPreview
'FORMLAPORAN.Show
End If
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Private Sub CMDRESET_Click()
Me.TABELDATA.RowSource = ""
Me.PENARIKAN.value = False
Me.SETORAN.value = False
Me.TGLAWAL.value = ""
Me.TOTALDATA.value = ""
Me.TOTALNILAI.value = ""
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Private Sub gambartgl_Click()
Dim dateVariable As Date
dateVariable = CalendarForm.GetDate
If dateVariable <> 0 Then TGLAWAL = Format(dateVariable, "dd/mm/yyyy")
End Sub
Private Sub gambartgl1_Click()
Dim dateVariable As Date
dateVariable = CalendarForm.GetDate
If dateVariable <> 0 Then TGLAKHIR = Format(dateVariable, "dd/mm/yyyy")
End Sub
Private Sub SETORAN_Click()
End Sub
Private Sub TOTALNILAI_Change()
Me.TOTALNILAI.value = Format(Me.TOTALNILAI.value, "Rp #,###")
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")
TGLAKHIR.value = Format(Now(), "dd/mm/yyyy")
TGLAWAL.SetFocus
TABELDATA.ColumnWidths = "30,80,70,40,150,40,100,150"
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Dim berhenti As Boolean
berhenti = True
Unload Me
Sheet1.Protect "1", userinterfaceonly:=True
End
End Sub
Form Laporan Santri (modifikasi)
Option Explicit
Private Sub CMDCARI1_Click()
Call CariSatu
Me.CMDPRINT.Visible = True
Me.CMDPRINT2.Visible = False
Me.CMDPRINT3.Visible = False
Me.TXTCARI2.value = ""
Me.CBKRITERIA2.value = ""
Me.TGLAWAL2.value = ""
Sheet1.Select
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Private Sub CariTiga()
Dim gabung As Range
Set gabung = Sheet8.Range("A4")
gabung.CurrentRegion.Clear
Sheet4.Range("setoranrange").Copy Sheet8.Range("A4:I4")
Dim iRow As Long
iRow = Sheet8.Range("A" & Rows.Count).End(xlUp).Row
Sheet5.Range("penarikanrange").Copy Sheet8.Range("A" & iRow + 1)
On Error GoTo Salah
Dim iRow3 As Long
Dim JData As Long
Dim CARI_DATA As Object
Set CARI_DATA = Sheet8
Sheet9.Range("A6").CurrentRegion.Clear
'
''========tes berdasarkan tanggal
Sheet9.Range("L4").value = "Tanggal"
Sheet9.Range("M4").value = "Tanggal"
Sheet9.Range("L5").value = ">=" & Format(Me.TGLAWAL2.value, "mm/dd/yyyy")
Sheet9.Range("M5").value = "<=" & Format(Me.TGLAKHIR2.value, "mm/dd/yyyy")
CARI_DATA.Range("A4").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Sheet9.Range("L4:M5"), CopyToRange:=Sheet9.Range("A6:I6"), Unique:=False
Sheet9.Select
Call urut3
'=====membuat nomor urut otomatis==============
Dim i As Long
Dim X As Long
Dim no As Long
X = Sheet9.Range("B" & Rows.Count).End(xlUp).Row
no = 0
For i = 1 To X - 6
no = no + 1
Cells(i + 6, 1).value = no
Next i
'============= memasukkan ke listbox
iRow = Sheet9.Range("A" & Rows.Count).End(xlUp).Row
If Application.WorksheetFunction.CountA(Sheet9.Range("A5:A1000000")) = 0 Then
Me.TABELDATA.RowSource = ""
Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")
Else
Me.TABELDATA.RowSource = "CARIGABUNG1!A7:I" & iRow
Me.TOTALDATA.value = Me.TABELDATA.ListCount
Me.TOTALNILAI.value = Sheet9.Range("H3").value
End If
Exit Sub
Salah:
Call MsgBox("Maaf Data tidak ditemukan", vbInformation, "Cari Data")
End Sub
Private Sub CariDua()
Dim gabung As Range
Set gabung = Sheet8.Range("A4")
gabung.CurrentRegion.Clear
Sheet4.Range("setoranrange").Copy Sheet8.Range("A4:I4")
Dim iRow As Long
iRow = Sheet8.Range("A" & Rows.Count).End(xlUp).Row
Sheet5.Range("penarikanrange").Copy Sheet8.Range("A" & iRow + 1)
'
''========tes berdasarkan tanggal
'Sheet9.Range("L4").value = "Tanggal"
'Sheet9.Range("M4").value = "Tanggal"
'Sheet9.Range("L5").value = ">=" & Format(Me.TGLAWAL1.value, "mm/dd/yyyy")
'Sheet9.Range("M5").value = "<=" & Format(Me.TGLAKHIR1.value, "mm/dd/yyyy")
'CARI_DATA.Range("A4").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
'Sheet9.Range("L4:M5"), CopyToRange:=Sheet9.Range("A6:I6"), Unique:=False
'========PENYARINGAN TAHAP 1 berdasarkan nama masuk dalam sheet CARIGABUNG1
On Error GoTo Salah
Dim iRow3 As Long
Dim JData3 As Long
Dim CARI_DATA3 As Object
Set CARI_DATA3 = Sheet8
Sheet9.Range("A6").CurrentRegion.Clear
Sheet9.Range("L4").value = Me.CBKRITERIA2.value
Sheet9.Range("L5").value = "*" & Me.TXTCARI2.value & "*"
CARI_DATA3.Range("A4").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Sheet9.Range("L4:L5"), CopyToRange:=Sheet9.Range("A6:I6"), Unique:=False
Sheet9.Select
Call urut3
'===nomor urut otomatis==========
Dim i As Long
Dim X As Long
Dim no As Long
X = Sheet9.Range("B" & Rows.Count).End(xlUp).Row
no = 0
For i = 1 To X - 6
no = no + 1
Cells(i + 6, 1).value = no
Next i
'============= memasukkan ke listbox
iRow = Sheet9.Range("A" & Rows.Count).End(xlUp).Row
If Application.WorksheetFunction.CountA(Sheet9.Range("A5:A1000000")) = 0 Then
Me.TABELDATA.RowSource = ""
Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")
Else
Me.TABELDATA.RowSource = "CARIGABUNG1!A7:I" & iRow
Me.TOTALDATA.value = Me.TABELDATA.ListCount
Me.TOTALNILAI.value = Sheet9.Range("H3").value
End If
Exit Sub
Salah:
Call MsgBox("Maaf Data tidak ditemukan", vbInformation, "Cari Data")
End Sub
Private Sub CariSatu()
Application.ScreenUpdating = False
Dim gabung As Range
Set gabung = Sheet8.Range("A4")
gabung.CurrentRegion.Clear
Sheet4.Range("setoranrange").Copy Sheet8.Range("A4:I4")
Dim iRow As Long
iRow = Sheet8.Range("A" & Rows.Count).End(xlUp).Row
Sheet5.Range("penarikanrange").Copy Sheet8.Range("A" & iRow + 1)
'Sheet8.Select
'Sheet9.Select
'####################################################
On Error GoTo Salah
Dim iRow2 As Long
Dim JData As Long
Dim CARI_DATA As Object
Set CARI_DATA = Sheet8
Sheet9.Range("A6").CurrentRegion.Clear
'========test nama santri
'Sheet9.Range("L4").Value = "Nama Santri"
'Sheet9.Range("L5").Value = "*aqil*"
'CARI_DATA.Range("A4").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
'Sheet9.Range("L4:L5"), CopyToRange:=Sheet9.Range("A6:I6"), Unique:=False
'========tes berdasarkan tanggal
Sheet9.Range("L4").value = "Tanggal"
Sheet9.Range("M4").value = "Tanggal"
Sheet9.Range("L5").value = ">=" & Format(Me.TGLAWAL1.value, "mm/dd/yyyy")
Sheet9.Range("M5").value = "<=" & Format(Me.TGLAKHIR1.value, "mm/dd/yyyy")
CARI_DATA.Range("A4").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Sheet9.Range("L4:M5"), CopyToRange:=Sheet9.Range("A6:I6"), Unique:=False
'========PENYARINGAN TAHAP 2 ATAU CARIGABUNG2 berdasarkan nama==
On Error GoTo Salah
Dim iRow3 As Long
Dim JData3 As Long
Dim CARI_DATA3 As Object
Set CARI_DATA3 = Sheet9
Sheet10.Range("A6").CurrentRegion.Clear
Sheet10.Range("L4").value = Me.CBKRITERIA1.value
Sheet10.Range("L5").value = "*" & Me.TXTCARI1.value & "*"
CARI_DATA3.Range("A6").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Sheet10.Range("L4:L5"), CopyToRange:=Sheet10.Range("A6:I6"), Unique:=False
Sheet10.Select
Call urut1
'===membuat nomor urut otomatis==
Dim i As Long
Dim X As Long
Dim no As Long
X = Sheet10.Range("B" & Rows.Count).End(xlUp).Row
no = 0
For i = 1 To X - 6
no = no + 1
Cells(i + 6, 1).value = no
Next i
'============= memasukkan ke listbox
iRow = Sheet10.Range("A" & Rows.Count).End(xlUp).Row
If Application.WorksheetFunction.CountA(Sheet10.Range("A5:A1000000")) = 0 Then
Me.TABELDATA.RowSource = ""
Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")
Else
Me.TABELDATA.RowSource = "CARIGABUNG2!A7:I" & iRow
Me.TOTALDATA.value = Me.TABELDATA.ListCount
Me.TOTALNILAI.value = Sheet10.Range("H3").value
End If
Exit Sub
Salah:
Call MsgBox("Maaf Data tidak ditemukan", vbInformation, "Cari Data")
Application.ScreenUpdating = True
End Sub
Private Sub CariPenarikan()
On Error GoTo Salah
Dim iRow As Long
Dim JData As Long
Dim CARI_DATA As Object
Set CARI_DATA = Sheet5
Sheet7.Range("I4").value = "Tanggal"
Sheet7.Range("J4").value = "Tanggal"
Sheet7.Range("I5").value = ">=" & Format(Me.TGLAWAL.value, "mm/dd/yyyy")
Sheet7.Range("J5").value = "<=" & Format(Me.TGLAKHIR.value, "mm/dd/yyyy")
CARI_DATA.Range("A4").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Sheet7.Range("I4:J5"), CopyToRange:=Sheet7.Range("A4:G4"), 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:G" & iRow
End If
Exit Sub
Salah:
Call MsgBox("Maaf Data tidak ditemukan", vbInformation, "Cari Data")
End Sub
Private Sub CMDCARI_Click()
If Me.PENARIKAN.value = True Then
Me.SETORAN.value = False
Call CariPenarikan
Me.TOTALDATA.value = Me.TABELDATA.ListCount
Me.TOTALNILAI.value = Sheet7.Range("L4").value
End If
If Me.SETORAN.value = True Then
Me.PENARIKAN.value = False
Call CariSetoran
Me.TOTALDATA.value = Me.TABELDATA.ListCount
Me.TOTALNILAI.value = Sheet3.Range("L4").value
End If
End Sub
Private Sub CMDCARI2_Click()
Call CariDua
Me.CMDPRINT2.Visible = True
Me.CMDPRINT.Visible = False
Me.CMDPRINT3.Visible = False
Me.TGLAWAL1.value = ""
Me.CBKRITERIA1.value = ""
Me.TXTCARI1.value = ""
Me.TGLAWAL2.value = ""
Sheet1.Select
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Private Sub CMDCARI3_Click()
Call CariTiga
Me.CMDPRINT3.Visible = True
Me.CMDPRINT.Visible = False
Me.CMDPRINT2.Visible = False
Me.TGLAWAL1.value = ""
Me.CBKRITERIA1.value = ""
Me.TXTCARI1.value = ""
Me.TXTCARI2.value = ""
Me.CBKRITERIA2.value = ""
Sheet1.Select
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Private Sub cmdprint_Click()
Select Case MsgBox("Anda akan mencetak data" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Cetak Setoran")
Case vbNo
Exit Sub
Case vbYes
End Select
'#####################################################################
Dim cetak As Variant
cetak = MsgBox("Apakah anda yakin ingin mencetak?", vbQuestion + vbYesNo, "Cetak Laporan")
If cetak = vbYes Then
Sheet10.Select
'===proses cetak
ActiveWindow.SelectedSheets.PrintOut from:=1, To:=100000, Copies:=1
With Sheet10.PageSetup
.Orientation = xlPortrait
.LeftMargin = Application.CentimetersToPoints(0.5)
.RightMargin = Application.CentimetersToPoints(0.5)
.TopMargin = Application.CentimetersToPoints(2)
.BottomMargin = Application.CentimetersToPoints(2)
.Zoom = 79
.PrintArea = "$A:$I"
.PrintTitleRows = "$1:$6"
End With
With Sheet10
.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
.Columns(9).ColumnWidth = 17 'penarikan
End With
Sheet1.Select
MsgBox "Laporan berhasil dicetak", vbInformation, "Hasil Cetak"
End If
'Unload Me
'Sheet10.PrintPreview
'FORMLAPORANSANTRI.Show
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Private Sub CMDPRINT2_Click()
Select Case MsgBox("Anda akan mencetak data" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Cetak Setoran")
Case vbNo
Exit Sub
Case vbYes
End Select
'############################################################################
Dim cetak As Variant
cetak = MsgBox("Apakah anda yakin ingin mencetak?", vbQuestion + vbYesNo, "Cetak Laporan")
If cetak = vbYes Then
Sheet9.Select
'===proses cetak
ActiveWindow.SelectedSheets.PrintOut from:=1, To:=100000, Copies:=1
With Sheet9.PageSetup
.Orientation = xlPortrait
.LeftMargin = Application.CentimetersToPoints(0.5)
.RightMargin = Application.CentimetersToPoints(0.5)
.TopMargin = Application.CentimetersToPoints(2)
.BottomMargin = Application.CentimetersToPoints(2)
.Zoom = 79
.PrintArea = "$A:$I"
.PrintTitleRows = "$1:$6"
End With
With Sheet9
.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
.Columns(9).ColumnWidth = 17 'penarikan
End With
Sheet1.Select
MsgBox "Laporan berhasil dicetak", vbInformation, "Hasil Cetak"
End If
'Unload Me
'Sheet9.PrintPreview
'FORMLAPORANSANTRI.Show
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Private Sub CMDPRINT3_Click()
Select Case MsgBox("Anda akan mencetak data" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Cetak Setoran")
Case vbNo
Exit Sub
Case vbYes
End Select
'#################################################
Dim cetak As Variant
cetak = MsgBox("Apakah anda yakin ingin mencetak?", vbQuestion + vbYesNo, "Cetak Laporan")
If cetak = vbYes Then
Sheet9.Select
'===proses cetak
ActiveWindow.SelectedSheets.PrintOut from:=1, To:=100000, Copies:=1
With Sheet9.PageSetup
.Orientation = xlPortrait
.LeftMargin = Application.CentimetersToPoints(0.5)
.RightMargin = Application.CentimetersToPoints(0.5)
.TopMargin = Application.CentimetersToPoints(2)
.BottomMargin = Application.CentimetersToPoints(2)
.Zoom = 79
.PrintArea = "$A:$I"
.PrintTitleRows = "$1:$6"
End With
With Sheet9
.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 = 18 'keterangan
.Columns(8).ColumnWidth = 17 'setoran
.Columns(9).ColumnWidth = 17 'penarikan
End With
Sheet1.Select
MsgBox "Laporan berhasil dicetak", vbInformation, "Hasil Cetak"
End If
Sheet1.Protect "1", userinterfaceonly:=True
'Unload Me
'Sheet9.PrintPreview
'FORMLAPORANSANTRI.Show
End Sub
Private Sub CMDRESET_Click()
Me.TABELDATA.RowSource = ""
Me.TGLAWAL1.value = ""
Me.TGLAKHIR1.value = Format(Now(), "dd/mm/yyyy")
Me.CBKRITERIA1.value = ""
Me.TXTCARI1.value = ""
Me.CBKRITERIA2.value = ""
Me.TXTCARI2.value = ""
Me.TGLAWAL2.value = ""
Me.TGLAKHIR2.value = Format(Now(), "dd/mm/yyyy")
Me.TOTALDATA.value = ""
Me.TOTALNILAI.value = ""
Me.CMDPRINT.Visible = False
Me.CMDPRINT2.Visible = False
Me.CMDPRINT3.Visible = False
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Private Sub gambartgl_Click()
Dim dateVariable As Date
dateVariable = CalendarForm.GetDate
If dateVariable <> 0 Then TGLAWAL1 = Format(dateVariable, "dd/mm/yyyy")
End Sub
Private Sub gambartgl1_Click()
Dim dateVariable As Date
dateVariable = CalendarForm.GetDate
If dateVariable <> 0 Then TGLAKHIR1 = Format(dateVariable, "dd/mm/yyyy")
End Sub
Private Sub gambartgl2_Click()
Dim dateVariable As Date
dateVariable = CalendarForm.GetDate
If dateVariable <> 0 Then TGLAWAL2 = Format(dateVariable, "dd/mm/yyyy")
End Sub
Private Sub gambartgl3_Click()
Dim dateVariable As Date
dateVariable = CalendarForm.GetDate
If dateVariable <> 0 Then TGLAKHIR2 = Format(dateVariable, "dd/mm/yyyy")
End Sub
Private Sub TOTALNILAI_Change()
Me.TOTALNILAI.value = Format(Me.TOTALNILAI.value, "Rp #,###")
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")
With CBKRITERIA1
.AddItem "NISN"
.AddItem "Nama Santri"
.AddItem "Kelas"
End With
With CBKRITERIA2
.AddItem "NISN"
.AddItem "Nama Santri"
.AddItem "Kelas"
End With
TGLAKHIR1.value = Format(Now(), "dd/mm/yyyy")
TGLAWAL1.SetFocus
TGLAKHIR2.value = Format(Now(), "dd/mm/yyyy")
Me.CMDPRINT.Visible = False
Me.CMDPRINT2.Visible = False
Me.CMDPRINT3.Visible = False
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Dim berhenti As Boolean
berhenti = True
Unload Me
End
End Sub
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
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
Form Siswa
Option Explicit
Private Sub CDMDDELETE_Click()
Application.ScreenUpdating = False
Me.TABELDATA.value = ""
If Me.TXTNISN.value = "" Then
Call MsgBox("Pilih data pada tabel data", vbInformation, "Hapus Data")
Else
'Membuat pesan konfirmasi hapus data
Select Case MsgBox("Apakah anda akan menghapus Akun Santri tersebut ???" _
& vbCrLf & "Seluruh Data Setoran dan Data Penarikan Santri tersebut juga terhapus" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Hapus Data")
Case vbNo
Exit Sub
Case vbYes
Sheet2.Select
Call hapusakun
'Selection.EntireRow.Delete
'Call MsgBox("Data berhasil dihapus", vbInformation, "Hapus Data")
End Select
Sheet2.Select
Me.TXTNISN.value = ""
Me.TXTNAMASISWA.value = ""
Me.CBKELAMIN.value = ""
Me.CBKELAS.value = ""
Me.CBKETERANGAN.value = ""
Me.TXTTAHUN.value = ""
Me.TXTHPORTU.value = ""
Sheet1.Select
End If
If Sheet2.Range("I2").value = 0 Then
Me.lbltotalnama.Caption = ""
Else
Me.lbltotalnama.Caption = "Total Saldo " & Format(Sheet2.Range("I2").value, "Rp #,###")
End If
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Private Sub CDMRESET_Click()
Me.TXTNISN.value = ""
Me.TXTNAMASISWA.value = ""
Me.CBKELAMIN.value = ""
Me.CBKELAS.value = ""
Me.CBKETERANGAN.value = ""
Me.TXTTAHUN.value = ""
Me.TXTHPORTU.value = ""
Me.CBKRITERIA.value = ""
Me.TXTCARI.value = ""
Call AmbilData
Me.CMDADD.Enabled = True
If Sheet2.Range("I2").value = 0 Then
Me.lbltotalnama.Caption = ""
Else
Me.lbltotalnama.Caption = "Total Saldo " & Format(Sheet2.Range("I2").value, "Rp #,###")
End If
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 = Sheet2
Sheet6.Range("A6").value = "1"
Sheet6.Range("carisiswaisi").Clear
Sheet6.Range("M2").value = Me.CBKRITERIA.value
Sheet6.Range("M3").value = "*" & Me.TXTCARI.value & "*"
CARI_DATA.Range("datasiswajudul").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Sheet6.Range("M2:M3"), CopyToRange:=Sheet6.Range("A5:I5"), Unique:=False
iRow = Sheet6.Range("A" & Rows.Count).End(xlUp).Row
If Application.WorksheetFunction.CountA(Sheet6.Range("A5:A1000000")) = 0 Then
Me.TABELDATA.RowSource = ""
Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")
Else
Me.TABELDATA.RowSource = "CARISISWA!A6:I" & iRow
End If
Me.TXTJUMLAH.value = Me.TABELDATA.ListCount
If Sheet6.Range("I2").value = 0 Then
Me.lbltotalnama.Caption = ""
Else
Me.lbltotalnama.Caption = "Total Saldo " & Format(Sheet6.Range("I2").value, "Rp #,###")
End If
Me.CMDPRINT.Visible = True
Me.CMDPRINTALL.Visible = False
Exit Sub
Salah:
Call MsgBox("Maaf Data tidak ditemukan", vbInformation, "Cari Data")
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
Sheet6.Select
'===proses cetak
ActiveWindow.SelectedSheets.PrintOut from:=1, To:=1, Copies:=1
With Sheet12.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:$5"
End With
With Sheet12
.Columns(1).ColumnWidth = 4 'nomor
.Columns(2).ColumnWidth = 5 'nisn
.Columns(3).ColumnWidth = 20 'nama santri
.Columns(4).ColumnWidth = 7.5 'kelas
.Columns(5).ColumnWidth = 11 'status aktif
.Columns(6).ColumnWidth = 12.5 'tahun masuk
.Columns(7).ColumnWidth = 16.5 'hp ortu
.Columns(8).ColumnWidth = 17.5 'saldo tabungan
End With
Sheet1.Select
MsgBox "Laporan berhasil dicetak", vbInformation, "Hasil Cetak"
End If
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Private Sub CMDPRINTALL_Click()
Dim cetak As Variant
cetak = MsgBox("Apakah anda yakin ingin mencetak?", vbQuestion + vbYesNo, "Cetak Laporan")
If cetak = vbYes Then
Sheet2.Select
'===proses cetak
ActiveWindow.SelectedSheets.PrintOut from:=1, To:=100000, Copies:=1
With Sheet12.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 Sheet12
.Columns(1).ColumnWidth = 4 'nomor
.Columns(2).ColumnWidth = 5 'nisn
.Columns(3).ColumnWidth = 20 'nama santri
.Columns(4).ColumnWidth = 7.5 'kelas
.Columns(5).ColumnWidth = 11 'status aktif
.Columns(6).ColumnWidth = 12.5 'tahun masuk
.Columns(7).ColumnWidth = 16.5 'hp ortu
.Columns(8).ColumnWidth = 17.5 'saldo tabungan
End With
Sheet1.Select
MsgBox "Laporan berhasil dicetak", vbInformation, "Hasil Cetak"
End If
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Private Sub CMDUPDATE_Click()
Application.ScreenUpdating = False
Dim baris As String
If Me.TXTNISN.value = "" Then
Call MsgBox("Pilih data terlebih dahulu", vbInformation, "Pilih Data")
Else
Sheet2.Select
baris = ActiveCell.Row
Cells(baris, 2) = Me.TXTNISN.value
Cells(baris, 3) = Me.TXTNAMASISWA.value
Cells(baris, 4) = Me.CBKELAMIN.value
Cells(baris, 5) = Me.CBKELAS.value
Cells(baris, 6) = Me.CBKETERANGAN.value
Cells(baris, 7) = Me.TXTTAHUN.value
Cells(baris, 8) = Me.TXTHPORTU.value
Call MsgBox("Data berhasil di update", vbInformation, "Update Data")
Me.TXTNISN.value = ""
Me.TXTNAMASISWA.value = ""
Me.CBKELAMIN.value = ""
Me.CBKELAS.value = ""
Me.CBKETERANGAN.value = ""
Me.TXTTAHUN.value = ""
Me.TXTHPORTU.value = ""
End If
Sheet1.Select
If Sheet2.Range("I2").value = 0 Then
Me.lbltotalnama.Caption = ""
Else
Me.lbltotalnama.Caption = "Total Saldo " & Format(Sheet2.Range("I2").value, "Rp #,###")
End If
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Private Sub printtabungandatasantri_Click()
Dim baris As Byte
Dim cetak As Variant
Application.ScreenUpdating = False
Me.TABELDATA.value = ""
If Me.TXTNISN.value = "" Then
Call MsgBox("Pilih Data Santri yang akan dicetak !", vbInformation, "Cetak Tabungan")
Else
cetak = MsgBox("Pastikan buku bank, sudah dimasukkan ke mulut printer !" + vbCrLf + _
"Apakah anda ingin melanjutkan cetak??", vbQuestion + vbYesNo, "Cetak Buku Tabungan")
If cetak = vbYes Then
Sheet14.Range("$B$1:$B$3,$C$6:$C$7,$E$6").ClearContents
Sheet2.Select
Call cetakidentitassantri
'########################################
'===proses cetak di buku tabungan
ActiveWindow.SelectedSheets.PrintOut from:=1, To:=1, Copies:=1
With Sheet14.PageSetup
.Orientation = xlPortrait
.LeftMargin = Application.CentimetersToPoints(1.7)
.RightMargin = Application.CentimetersToPoints(0.2)
.TopMargin = Application.CentimetersToPoints(0)
.BottomMargin = Application.CentimetersToPoints(1.3)
.Zoom = 87
.PrintArea = "$A$1:$E$7"
End With
With Sheet14
.Columns(1).ColumnWidth = 11.14
.Columns(2).ColumnWidth = 11.86
.Columns(3).ColumnWidth = 8.71
.Columns(4).ColumnWidth = 10.71
.Columns(5).ColumnWidth = 18
End With
Sheet1.Select
MsgBox "Identitas santri berhasil dicetak", vbInformation, "Cetak Identitas"
End If
End If
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Private Sub TABELDATA_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim SUMBERUBAH, CELLAKTIF As String
Application.ScreenUpdating = False
On Error GoTo EXCELVBA
Me.TXTNISN.value = Me.TABELDATA.Column(1)
Me.TXTNAMASISWA.value = Me.TABELDATA.Column(2)
Me.CBKELAMIN.value = Me.TABELDATA.Column(3)
Me.CBKELAS.value = Me.TABELDATA.Column(4)
Me.CBKETERANGAN.value = Me.TABELDATA.Column(5)
Me.TXTTAHUN.value = Me.TABELDATA.Column(6)
Me.TXTHPORTU.value = Me.TABELDATA.Column(7)
Sheet2.Select
SUMBERUBAH = Sheets("DATASISWA").Cells(Rows.Count, "B").End(xlUp).Row
Sheets("DATASISWA").Range("B4:B" & SUMBERUBAH).Find(What:=Me.TXTNISN.value, LookIn:=xlValues, LookAt:=xlWhole).Activate
CELLAKTIF = ActiveCell.Row
Sheets("DATASISWA").Range("A" & CELLAKTIF & ":I" & CELLAKTIF).Select
Sheet1.Select
Me.CMDADD.Enabled = False
If Sheet2.Range("I2").value = 0 Then
Me.lbltotalnama.Caption = ""
Else
Me.lbltotalnama.Caption = "Total Saldo " & Format(Sheet2.Range("I2").value, "Rp #,###")
End If
Exit Sub
EXCELVBA:
Call MsgBox("Klik 2x pada tabel data", vbInformation, "Pilih Data")
End Sub
'Private Sub TXTNISN_AfterUpdate()
Sub nisnganda()
Dim DBSISWA As Object
Dim c As Object
If TXTNISN.value = "" Then
MsgBox "Lengkapi data terlebih dahulu", vbInformation, "Data Belum Lengkap"
Else
Set DBSISWA = Sheet2.Range("B1000000").End(xlUp)
With Sheet2.Range("B5:B1000000")
Set c = .Find(TXTNISN.value, LookIn:=xlValues)
If c Is Nothing Then
Exit Sub
Else
MsgBox "NISN Sudah ada, silahkan ganti yang lainnya", vbOKOnly + vbCritical, "NISN Ganda"
TXTNISN.value = ""
End If
End With
End If
'
'If Application.CountIf(Range("B5:B100000"), TXTNISN) > 0 Then
'MsgBox "NISN Sudah ada, silahkan ganti yang lainnya", vbOKOnly + vbCritical, "NISN Ganda"
'TXTNISN.SetFocus
'End If
End Sub
Private Sub TXTHPORTU_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 TXTNISN_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 TXTTAHUN_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()
Me.CMDPRINT.Visible = False
lbltg.Caption = Format(Now(), "dddd, dd mmmm yyyy")
Call AmbilData
With CBKELAMIN
.AddItem "Laki - Laki"
.AddItem "Perempuan"
End With
With CBKELAS
.AddItem "Kelas 7"
.AddItem "Kelas 8"
.AddItem "Kelas 9"
.AddItem "Kelas 10"
.AddItem "Kelas 11"
.AddItem "Kelas 12"
End With
With CBKETERANGAN
.AddItem "Aktif"
.AddItem "Non-Aktif"
End With
With CBKRITERIA
.AddItem "NISN"
.AddItem "Nama Santri"
.AddItem "Jenis Kelamin"
.AddItem "Kelas"
.AddItem "Status"
.AddItem "Tahun Masuk"
End With
TXTNISN.SetFocus
If Sheet2.Range("I2").value = 0 Then
Me.lbltotalnama.Caption = ""
Else
Me.lbltotalnama.Caption = "Total Saldo " & Format(Sheet2.Range("I2").value, "Rp #,###")
End If
TABELDATA.ColumnWidths = "30,40,125,80,50,50,70,80,100"
End Sub
Private Sub AmbilData()
Dim TData As Long
Dim iRow As Long
iRow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
TData = Application.WorksheetFunction.CountA(Sheet2.Range("B5:B1000000"))
If TData = 0 Then
Me.TABELDATA.RowSource = ""
Else
Me.TABELDATA.RowSource = "DATASISWA!A5:I" & iRow
End If
Me.TXTJUMLAH.value = Me.TABELDATA.ListCount
End Sub
Private Sub CMDADD_Click()
Dim DBSISWA As Object
Call nisnganda
Set DBSISWA = Sheet2.Range("B1000000").End(xlUp)
If Me.TXTNISN.value = "" _
Or Me.TXTNAMASISWA.value = "" _
Or Me.CBKELAMIN.value = "" _
Or Me.CBKELAS.value = "" _
Or Me.CBKETERANGAN.value = "" _
Or Me.TXTTAHUN.value = "" _
Or Me.TXTHPORTU.value = "" Then
Call MsgBox("Isi data santri masuk dengan lengkap", vbInformation, "Santri Masuk")
Else
DBSISWA.Offset(1, -1).value = "=ROW()-ROW(DATASISWA!$A$4)"
DBSISWA.Offset(1, 0).value = Me.TXTNISN.value
DBSISWA.Offset(1, 1).value = Me.TXTNAMASISWA.value
DBSISWA.Offset(1, 2).value = Me.CBKELAMIN.value
DBSISWA.Offset(1, 3).value = Me.CBKELAS.value
DBSISWA.Offset(1, 4).value = Me.CBKETERANGAN.value
DBSISWA.Offset(1, 5).value = Me.TXTTAHUN.value
DBSISWA.Offset(1, 6).value = Me.TXTHPORTU.value
Call AmbilData
Call MsgBox("Data santri telah disimpan", vbInformation, "Santri Masuk")
Me.TXTNISN.value = ""
Me.TXTNAMASISWA.value = ""
Me.CBKELAMIN.value = ""
Me.CBKELAS.value = ""
Me.CBKETERANGAN.value = ""
Me.TXTTAHUN.value = ""
Me.TXTHPORTU.value = ""
End If
If Sheet2.Range("I2").value = 0 Then
Me.lbltotalnama.Caption = ""
Else
Me.lbltotalnama.Caption = "Total Saldo " & Format(Sheet2.Range("I2").value, "Rp #,###")
End If
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Dim berhenti As Boolean
berhenti = True
Unload Me
End
End Sub
Senin, 08 November 2021
Resize Melompat
Sub test()
Range("B3:C3").Select
Selection.Offset(2, 2).Resize(Selection.Rows.Count + 2, Selection.Columns.Count + 1).Select
End Sub
Resize
Sub tess()
Range("B3:C3").Select
Selection.Resize(Selection.Rows.Count + 5, Selection.Columns.Count).Select
End Sub
Cell paling awal dan ujung cell yang terakhir
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Baris awal di bawah judul (Baris kosong pertama di database)
aku = Sheet1.Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Row
Range("D" & aku).Select
Ukuran Lebar dan Tinggi Cell
Sub tess() ActiveCell.EntireColumn.ColumnWidth = 12 ActiveCell.EntireRow.RowHeight = 35 End Sub
Hide-Unhide Sheet
Sub tess() Sheet1.Visible = 1 ' angka 2 hide ' angka 1 unhide ' true 'false End Sub
Senin, 01 November 2021
Pencarian : Filter NISN dan Siswa copy -Setoran
Private Sub CMDCARI_Click()
On Error GoTo Salah
Dim iRow As Long
Dim JData As Long
Dim CARI_DATA As Object
Set CARI_DATA = Sheet2
Sheet6.Range("K4").Value = Me.CBKRITERIA.Value
Sheet6.Range("K5").Value = "*" & Me.TXTCARI.Value & "*"
CARI_DATA.Range("A4").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Sheet6.Range("K4:K5"), CopyToRange:=Sheet6.Range("A4:I4"), Unique:=False
iRow = Sheet6.Range("A" & Rows.Count).End(xlUp).Row
If Application.WorksheetFunction.CountA(Sheet6.Range("A5:A60000")) = 0 Then
Me.TABELDATA.RowSource = ""
Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")
Else
Me.TABELDATA.RowSource = "CARISISWA!A5:I" & iRow
End If
Me.TXTJUMLAH.Value = Me.TABELDATA.ListCount
Exit Sub
Salah:
Call MsgBox("Maaf Data tidak ditemukan", vbInformation, "Cari Data")
End Sub
Pencarian : Filter Copy Tanggal
Private Sub CariSetoran()
On Error GoTo Salah
Dim iRow As Long
Dim JData As Long
Dim CARI_DATA As Object
Set CARI_DATA = Sheet4
Sheet3.Range("I4").Value = "Tanggal"
Sheet3.Range("J4").Value = "Tanggal"
Sheet3.Range("I5").Value = ">=" & Format(Me.TGLAWAL.Value, "MM/DD/YYYY")
Sheet3.Range("J5").Value = "<=" & Format(Me.TGLAKHIR.Value, "MM/DD/YYYY")
CARI_DATA.Range("A4").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Sheet3.Range("I4:J5"), CopyToRange:=Sheet3.Range("A4:G4"), Unique:=False
iRow = Sheet3.Range("A" & Rows.Count).End(xlUp).Row
If Application.WorksheetFunction.CountA(Sheet3.Range("A5:A60000")) = 0 Then
Me.TABELDATA.RowSource = ""
Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")
Else
Me.TABELDATA.RowSource = "CARISETORAN!A5:G" & iRow
End If
Exit Sub
Salah:
Call MsgBox("Maaf Data tidak ditemukan", vbInformation, "Cari Data")
Langganan:
Postingan (Atom)