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"...
-
Salin ke Clipboard Salin ke Clipboard Salin Tercopy! ...
-
=MOD(ROW();2)=1
-
Option Explicit Private Sub Workbook_BeforeClose(Cancel As Boolean) Select Case MsgBox("Apakah anda ingin menyimpan file ini?", v...
Tidak ada komentar:
Posting Komentar