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