Ebook Trik Excel

 klik di sini

uCase Looping

 klik di sini

https://trumpexcel.com/vba-ucase/

Pengaturan Cetak Dafnil, Dafdir, dan Raport

With Sheet1.PageSetup
.PaperSize = xlPaperLegal
.BottomMargin = Application.CentimetersToPoints(3)
End With

Backup File

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Dim saveDate As Date
    Dim saveTime As Variant
    Dim formatTime As String
    Dim formatDate As String
    Dim backupFolder As String

    saveDate = Date
    saveTime = Time

    formatTime = Format(saveTime, "hh.MM.ss")
    formatDate = Format(saveDate, "DD MMM YYYY")

    Application.DisplayAlerts = False
        backupFolder = ThisWorkbook.Path & "\"
        ActiveWorkbook.SaveCopyAs Filename:=backupFolder & Replace("Backup-" & ActiveWorkbook.Name, ".xlsb", "") & " " & formatDate & " " & formatTime & ".xlsb"
    Application.DisplayAlerts = True

'    MsgBox "Backup Successfully In The Path " & backupFolder
End Sub

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