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
Minggu, 28 November 2021
Form Laporan (Bawa'an)
Langganan:
Posting Komentar (Atom)
Menghitung USIA Excel
=BYROW(D2:D100; LAMBDA(tanggal_lahir; IF(tanggal_lahir=""; ""; DATEDIF(tanggal_lahir; TODAY(); "y"...
-
Option Explicit Private Sub hasilpencariangabung() Dim gabung As Range Set gabung = Sheet8.Range("A4") gabung.CurrentRegion.Cl...
-
=BYROW(D2:D100; LAMBDA(tanggal_lahir; IF(tanggal_lahir=""; ""; DATEDIF(tanggal_lahir; TODAY(); "y"...
-
=MOD(ROW();2)=1
Tidak ada komentar:
Posting Komentar