Minggu, 28 November 2021

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
di
Label:

Tidak ada komentar:

Posting Komentar

Langganan: Posting Komentar (Atom)

Menghitung USIA Excel

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