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
Minggu, 28 November 2021
Worksheet MENU
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
Langganan:
Postingan (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 Sub test() Dim fileku As String, lokasi As String lokasi = "D:\Raport Nafa\" fileku = Dir(lokasi & "*...