Minggu, 28 November 2021

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

Tidak ada komentar:

Posting Komentar

Menghitung USIA Excel

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