Minggu, 28 November 2021

Worksheet MENU




Private Sub CMDRESETALL_Click()
Dim pesan As Variant
pesan = MsgBox("Apakah anda yakin ingin mereset data?" + vbCrLf + _
"Tindakan ini menyebabkan seluruh data santri, data setoran dan data penarikan akan dihapus semuanya", vbQuestion + vbOKCancel, "Reset Data")

If pesan = vbOK Then
Sheet2.Range("A5") = 1
Sheet4.Range("A5") = 1
Sheet4.Range("K3") = 0
Sheet5.Range("A5") = 1
Sheet5.Range("K3") = 0
Sheet2.Range("datasiswatanpajudul").ClearContents
Sheet4.Range("datasetorantanpajudul").ClearContents
Sheet5.Range("datapenarikantanpajudul").ClearContents
Sheet2.Range("A5") = 1
Sheet4.Range("A5") = 1
Sheet4.Range("K3") = 0
Sheet5.Range("A5") = 1
Sheet5.Range("K3") = 0
MsgBox "Seluruh data berhasil dihapus", vbInformation, "Reset Data"
Else
Exit Sub
End If


End Sub

Private Sub Worksheet_Activate()
ActiveWindow.DisplayHeadings = False
ActiveWindow.View = xlNormalView
ActiveWindow.DisplayGridlines = False
ActiveWindow.DisplayHeadings = False
ActiveWindow.DisplayWorkbookTabs = True
ActiveWindow.Zoom = 100
End Sub




Workbook Tabungan







Private Sub Workbook_BeforeClose(Cancel As Boolean)
Select Case MsgBox("Apakah anda ingin menyimpan file ini?", vbYesNo + vbQuestion, "Informasi")
Case Is = vbNo

Application.Quit
Exit Sub
Case Is = vbYes
ThisWorkbook.Save
Application.Quit
End Select

End Sub

Private Sub Workbook_Open()
Sheet1.Protect "1", userinterfaceonly:=True
Sheet1.Select

With Application

    .Caption = " | created By @qil"
    .ExecuteExcel4Macro "Show.ToolBar(""Ribbon"",true)"
       
End With
ActiveWindow.DisplayWorkbookTabs = True

End Sub





Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Cancel = True
MsgBox "Maaf klik kanan dinonaktifkan", vbOKOnly + vbInformation, "Informasi"

End Sub





Modul User_name


Option Explicit

Sub user()
Application.ScreenUpdating = False
Dim a, b As String
a = InputBox("Masukkan nama Lengkap", "UserName")

b = InputBox("Masukkan Initial nama ( 3-4 huruf)", "Initial")


 Sheets("MENU").Range("$Z$24").value = a
 Sheets("MENU").Range("$Z$26").value = b

MsgBox "Penambahan Username Berhasil", vbInformation, "Informasi"
Sheet1.Protect "1", userinterfaceonly:=True
End Sub



Modul Urutkan_Hasil


Option Explicit

Sub urut3()
'===========mengurutkan berdasarkan tanggal==============
ActiveWorkbook.Sheets("CARIGABUNG1").Range("carigabung1range").Select
ActiveWorkbook.Sheets("CARIGABUNG1").Sort.SortFields.Clear
ActiveWorkbook.Sheets("CARIGABUNG1").Sort.SortFields.Add Key:=Range("tanggalcarigabung1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

With ActiveWorkbook.Sheets("CARIGABUNG1").Sort
    .SetRange Range("carigabung1range")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Sheet9.Select
Sheet1.Protect "1", userinterfaceonly:=True
End Sub


Sub urut1()
'===========mengurutkan berdasarkan tanggal==============
ActiveWorkbook.Sheets("CARIGABUNG2").Range("carigabung2range").Select
ActiveWorkbook.Sheets("CARIGABUNG2").Sort.SortFields.Clear
ActiveWorkbook.Sheets("CARIGABUNG2").Sort.SortFields.Add Key:=Range("tanggalcarigabung2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

With ActiveWorkbook.Sheets("CARIGABUNG2").Sort
    .SetRange Range("carigabung2range")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Sheet10.Select
Sheet1.Protect "1", userinterfaceonly:=True
End Sub



Modul Setting_printer


Option Explicit

Sub setting_printer()

'Application.Dialogs(xlDialogPrint).Show
'Application.Dialogs(xlDialogPrinterSetup).Show
'Sheet11.Select
Application.SendKeys ("^p")
'Sheet1.PrintPreview

'Application.Dialogs(xlDialogPageSetup).Show
Sheet1.Select

End Sub


Modul Menu


Sub bukalaporansantri()
Sheet1.Unprotect "1"
FORMLAPORANSANTRI.Show
Sheet1.Protect "1", userinterfaceonly:=True
End Sub

Sub BukaDataSiswa()
Sheet1.Unprotect "1"
FORMSISWA.Show
Sheet1.Protect "1", userinterfaceonly:=True
End Sub

Sub BukaSetoran()
Sheet1.Unprotect "1"
FORMSETORAN.Show
Sheet1.Protect "1", userinterfaceonly:=True
End Sub

Sub BukaPenarikan()
Sheet1.Unprotect "1"
FORMPENARIKAN.Show
Sheet1.Protect "1", userinterfaceonly:=True
End Sub

Sub Laporan()
Sheet1.Unprotect "1"
FORMLAPORAN.Show
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Sub LaporanSantri()
Sheet1.Unprotect "1"
FORMLAPORANSANTRI.Show
Sheet1.Protect "1", userinterfaceonly:=True
End Sub
Sub Simpan()
ThisWorkbook.Save
End Sub

Sub Keluar()
Select Case MsgBox("Anda akan keluar dari Aplikasi" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Keluar")
Case vbNo
Exit Sub
Case vbYes
End Select
ThisWorkbook.Save
ThisWorkbook.Close
End Sub





Modul Hapus_Akun


Sub hapusakun()
Dim rujukan As Range
Set rujukan = Sheets("SETORAN").Range("$O$2")

'===pencarian nomor induk===

rujukan.ClearContents
'Sheets("DATASISWA").Select
Selection.EntireRow.Select
Selection.Columns(2).Select
Selection.Copy
rujukan.PasteSpecial Paste:=xlPasteValues


'===proses hapus DATASISWA sesuai induk===
Dim jumlahsiswa, jumlahsetoran, jumlahpenarikan As Long
Dim baris As Long
On Error Resume Next
jumlahsiswa = Sheets("DATASISWA").Range("nisndatasiswa").Rows.Count
jumlahsetoran = Sheets("SETORAN").Range("nisnsetoran").Rows.Count
jumlahpenarikan = Sheets("PENARIKAN").Range("nisnpenarikan").Rows.Count

For baris = 5 To jumlahsiswa + 4
  Sheets("DATASISWA").Cells(baris, 2).Select
        If Selection.value = rujukan.value Then
        Selection.EntireRow.Delete
               
        End If
Next baris
Sheet2.Range("I2").value = "=SUM($I$5:$I$1000000)"
'===proses hapus SETORAN sesuai induk===
Sheets("SETORAN").Select

For baris = 5 To jumlahsetoran + 4
  Sheets("SETORAN").Cells(baris, 4).Select
        If Selection.value = rujukan.value Then
        Selection.EntireRow.ClearContents
        End If
Next baris
'=====hapus setoran yang sudah kosong=
Dim c As Long

c = Cells(Rows.Count, 1).End(xlUp).Row
Sheets("SETORAN").Range("A5:A" & c).Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
'===============================

Sheet4.Range("M3").value = "=SUM($H$5:$H$1000000)"

'===proses hapus PENARIKAN sesuai induk===
Sheets("PENARIKAN").Select

For baris = 5 To jumlahpenarikan + 4
  Sheets("PENARIKAN").Cells(baris, 4).Select
        If Selection.value = rujukan.value Then
        Selection.EntireRow.ClearContents
        
        End If
Next baris
'=====hapus penarikan yang sudah kosong=

c = Cells(Rows.Count, 1).End(xlUp).Row
Sheets("PENARIKAN").Range("A5:A" & c).Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
'===============================

Sheet5.Range("M3").value = "=SUM($I$5:$I$1000000)"

Sheet2.Range("A5") = 1
Sheet4.Range("A5") = 1
Sheet5.Range("A5") = 1

MsgBox "Data akun santri berhasil dihapus", vbInformation, "Hapus Akun"
Sheet1.Protect "1", userinterfaceonly:=True
End Sub





Menghitung USIA Excel

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