With Sheet1.PageSetup .PaperSize = xlPaperLegal .BottomMargin = Application.CentimetersToPoints(3) End With
Tampilkan postingan dengan label Raport Madin. Tampilkan semua postingan
Tampilkan postingan dengan label Raport Madin. Tampilkan semua postingan
Rabu, 08 Desember 2021
Pengaturan Cetak Dafnil, Dafdir, dan Raport
Sabtu, 30 Oktober 2021
Modul Rapikan Isi Nilai
Option Explicit
Sub rapikan_isinilai()
'
' rapikan_isinilai
'
Worksheets("isinilai").Unprotect "1"
Worksheets("isinilai").Range("L8:AJ57").Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Font
.Name = "Calibri"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.NumberFormat = "General"
.NumberFormat = "0.0"
.NumberFormat = "0"
.NumberFormat = "0.0"
.NumberFormat = "0.00"
.NumberFormat = "0.0"
.NumberFormat = "0"
End With
'====formatcondition====
' Worksheets("isinilai").Range("L8:AJ57").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLessEqual, _
Formula1:="=kkm"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.Color = -16777024
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 16764159
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("L8:AJ57").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=LEN(TRIM(L8))=0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.Locked = False
Worksheets("isinilai").Protect "1", userinterfaceonly:=True
End Sub
Modul Urut Dafdir
Option Explicit
Sub ranking_berdasarkan()
Worksheets("cetakdkn").Unprotect "1"
' Worksheets("cetakdkn").Range("D11:AH60").Copy
' Worksheets("cetakdkn").Range("D11").Select
Worksheets("cetakdkn").Range("D11:AH60").Select
ActiveWorkbook.Worksheets("cetakdkn").sort.SortFields.Clear
ActiveWorkbook.Worksheets("cetakdkn").sort.SortFields.Add Key:=Range( _
"D11:D60"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("cetakdkn").sort
.SetRange Range("D11:AH60")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Worksheets("cetakdkn").Range("D10").Select
Worksheets("cetakdkn").Protect "1", userinterfaceonly:=True
End Sub
Sub absen_berdsarkan()
Worksheets("cetakdkn").Unprotect "1"
' Worksheets("cetakdkn").Range("D11:AH60").Copy
' Worksheets("cetakdkn").Range("D11").Select
Worksheets("cetakdkn").Range("D11:AH60").Select
ActiveWorkbook.Worksheets("cetakdkn").sort.SortFields.Clear
ActiveWorkbook.Worksheets("cetakdkn").sort.SortFields.Add Key:=Range( _
"E11:E60"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("cetakdkn").sort
.SetRange Range("D11:AH60")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Worksheets("cetakdkn").Range("D10").Select
Worksheets("cetakdkn").Protect "1", userinterfaceonly:=True
End Sub
Modul Print Raport
Option Explicit
'=======Cetak_Raport_Madin=========
Sub cetak()
Worksheets("raport").Unprotect "1"
Dim mulai As Byte
Dim sampai As Byte
Dim a As Byte
mulai = Range("U11").Value
sampai = Range("W11").Value
For a = mulai To sampai
Range("V8") = a
Worksheets("raport").PrintOut from:=1, To:=1, Copies:=1
Next a
Worksheets("raport").Select
Worksheets("raport").Protect "1", userinterfaceonly:=True
End Sub
Sub cetak_saat_ini()
Worksheets("raport").Unprotect "1"
ActiveWindow.SelectedSheets.PrintOut from:=1, To:=1, Copies:=1
Worksheets("raport").Select
Worksheets("raport").Protect "1", userinterfaceonly:=True
End Sub
Sub cetak_DAFDIR()
Worksheets("dafdir").Unprotect "1"
ActiveWindow.SelectedSheets.PrintOut from:=2, To:=2, Copies:=1
Worksheets("dafdir").Select
Worksheets("dafdir").Protect "1", userinterfaceonly:=True
End Sub
Sub cetak_DAFTAR_NILAI()
Worksheets("cetakdkn").Unprotect "1"
ActiveWindow.SelectedSheets.PrintOut from:=3, To:=4, Copies:=1
Worksheets("cetakdkn").Select
Worksheets("cetakdkn").Protect "1", userinterfaceonly:=True
End Sub
Modul Paste Value
Option Explicit
Sub paste_value_isinilai()
On Error Resume Next
Selection.PasteSpecial paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
End Sub
Modul Merapikan Rt-rt Ganjil
Sub merapikan_rt2()
'
Worksheets("rtganjil").Unprotect "1"
Dim WS As Worksheet
Set WS = Worksheets("rtganjil")
WS.Range("G11:G60").Select
With Selection.Font
.Name = "Calibri"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Selection.Font.Bold = True
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Style = "Comma [0]"
Selection.NumberFormat = "_-* #,##0.0_-;-* #,##0.0_-;_-* ""-""_-;_-@_-"
Selection.NumberFormat = "_-* #,##0.00_-;-* #,##0.00_-;_-* ""-""_-;_-@_-"
Worksheets("rtganjil").Protect "1", userinterfaceonly:=True
End Sub
Modul "Merapikan Nama"
Option Explicit
Sub merapikan()
Worksheets("isinama").Unprotect "1"
'====merapikan tampilan nama santri ===========
Dim WS As Worksheet
Set WS = Worksheets("isinama")
WS.Range("H4:K53").Select
Selection.ClearFormats
With Selection.Font
.Name = "Calibri"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
WS.Range("H4:H53").Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlDuplicate
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Worksheets("isinama").Range("I4:J53").Select
Selection.Columns.AutoFit
Worksheets("isinama").Columns("J").ColumnWidth = 30
Worksheets("isinama").Range("H4:K53").Locked = False
Worksheets("isinama").Protect "1", userinterfaceonly:=True
End Sub
Modul Cek Nilai Rt2 Ganjil
Option Explicit
Sub cek_nilai_rata2ganjil()
Worksheets("rtganjil").Unprotect "1"
'#########################################################
Dim barisakhir As Byte
Dim barisakhir5 As Byte
Dim baris As Byte
Dim kolomakhir As Byte
'===menghapus nilai ke bawah yang tidak ada nama siswanya======
barisakhir = Worksheets("rtganjil").Range("D9").Value + 11
Cells(barisakhir, 7).Select
Range(Selection, "G60").Select
Selection.ClearContents
Range("G11").Select
Worksheets("rtganjil").Protect "1", userinterfaceonly:=True
End Sub
Modul Cek Nilai
Sub hapusinduk()
Worksheets("isinilai").Unprotect "1"
'#########################################################
Dim barisakhir As Byte
Dim barisakhir5 As Byte
Dim baris As Byte
Dim kolomakhir As Byte
'===menghapus nilai ke bawah yang tidak ada nama siswanya======
barisakhir = Worksheets("isinilai").Range("G5").Value + 8
Cells(barisakhir, 12).Select
Range(Selection, "AJ57").Select
Selection.ClearContents
'=====menghapus nilai ke samping yang tidak ada mapelnya=====
kolomakhir = Worksheets("isinilai").Range("I1").Value + 12
Cells(8, kolomakhir).Select
Range(Selection, "AJ57").Select
Selection.ClearContents
''==========menghapus induk yang kosong =============
barisakhir5 = Range("G5").Value + 7
For baris = 8 To barisakhir5
If Range("H" & baris).Value = 0 Then
For kolom = 12 To 36
Cells(baris, kolom).ClearContents
Next kolom
End If
Next baris
Worksheets("isinilai").Protect "1", userinterfaceonly:=True
End Sub
Workbook Raport
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
ActiveWindow.DisplayHeadings = True
ActiveWindow.View = xlNormalView
ActiveWindow.DisplayGridlines = True
ActiveWindow.DisplayHeadings = True
ActiveWindow.DisplayWorkbookTabs = True
End Sub
Private Sub Workbook_Open()
Application.ExecuteExcel4Macro "Show.ToolBar(""Ribbon"",true)"
'############################################################
Worksheets("data").Select
Worksheets("data").cmdreset.Visible = True
With Application
.DisplayFullScreen = True
.DisplayStatusBar = False
.DisplayDocumentInformationPanel = False
.DisplayFormulaBar = False
.EnableEvents = True
.Calculation = xlCalculationAutomatic
Application.Caption = " | created By @qil"
End With
'==============================================
Worksheets("data").Protect "1", userinterfaceonly:=True
Worksheets("isinama").Protect "1", userinterfaceonly:=True
Worksheets("isinilai").Protect "1", userinterfaceonly:=True
Worksheets("rtganjil").Protect "1", userinterfaceonly:=True
Worksheets("dafdir").Protect "1", userinterfaceonly:=True
Worksheets("cetakdkn").Protect "1", userinterfaceonly:=True
Worksheets("dkn").Protect "1", userinterfaceonly:=True
Worksheets("sikap").Protect "1", userinterfaceonly:=True
Worksheets("rank").Protect "1", userinterfaceonly:=True
Worksheets("raport").Protect "1", userinterfaceonly:=True
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Worksheets("data").Select
Select Case MsgBox("Apakah anda ingin menyimpan file ini?", vbYesNo + vbQuestion, "Informasi")
Case Is = vbNo
Application.DisplayAlerts = False
Application.Quit
Case Is = vbYes
ThisWorkbook.Save
End Select
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
Sheet Rank
'
'
Private Sub Worksheet_Activate()
Worksheets("rank").Unprotect "1"
Application.ScreenUpdating = False
'======copy dari dkn ke sheet rank==============
Worksheets("rank").Range("G16:AJ65").ClearContents
Worksheets("dkn").Range("nilaidkn").Copy
Sheets("rank").Range("G16").Select
Selection.PasteSpecial paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
'======copy RATA-RATA GANJIL dari DKN jika semester genap ==============
Worksheets("dkn").Range("rt2ganjil").Copy
Sheets("rank").Select
Range("AL16").Select
Selection.PasteSpecial paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("G16").Select
Worksheets("dkn").Range("rt2ganjil").Copy
Sheets("rank").Select
Range("AL16").Select
Selection.PasteSpecial paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("G16").Select
'=========sort mengurutkan peringkat===============
Range("G16:AN65").Select
ActiveWorkbook.Worksheets("rank").sort.SortFields.Clear
ActiveWorkbook.Worksheets("rank").sort.SortFields.Add Key:=Range("AN16:AN65") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("rank").sort.SortFields.Add Key:=Range("L16:L65"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("rank").sort.SortFields.Add Key:=Range("M16:M65"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("rank").sort.SortFields.Add Key:=Range("N16:N65"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("rank").sort.SortFields.Add Key:=Range("O16:O65"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("rank").sort.SortFields.Add Key:=Range("P16:P65"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("rank").sort.SortFields.Add Key:=Range("Q16:Q65"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("rank").sort.SortFields.Add Key:=Range("R16:R65"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("rank").sort.SortFields.Add Key:=Range("S16:S65"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("rank").sort.SortFields.Add Key:=Range("T16:T65"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("rank").sort.SortFields.Add Key:=Range("U16:U65"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("rank").sort.SortFields.Add Key:=Range("V16:V65"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("rank").sort.SortFields.Add Key:=Range("W16:W65"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("rank").sort.SortFields.Add Key:=Range("X16:X65"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("rank").sort.SortFields.Add Key:=Range("Y16:Y65"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("rank").sort.SortFields.Add Key:=Range("Z16:Z65"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("rank").sort.SortFields.Add Key:=Range("AA16:AA65") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("rank").sort.SortFields.Add Key:=Range("AB16:AB65") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("rank").sort.SortFields.Add Key:=Range("AC16:AC65") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("rank").sort.SortFields.Add Key:=Range("AD16:AD65") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("rank").sort.SortFields.Add Key:=Range("AE16:AE65") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("rank").sort.SortFields.Add Key:=Range("AF16:AF65") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("rank").sort.SortFields.Add Key:=Range("AG16:AG65") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("rank").sort.SortFields.Add Key:=Range("AH16:AH65") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("rank").sort.SortFields.Add Key:=Range("AI16:AI65") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("rank").sort.SortFields.Add Key:=Range("AJ16:AJ65") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("rank").sort
.SetRange Range("G16:AN65")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWindow.Zoom = 100
ActiveWindow.ScrollColumn = 1
'========mengatur lebar kolom ==============
Columns("H:I").EntireColumn.AutoFit
Columns("M:AJ").EntireColumn.AutoFit
Columns("J:K").Hidden = True
'===menyembunyikan kolom GANJIL TAHUN LALU saat diklik Genap==
If Worksheets("data").Range("P7").Value = "Ganjil" Then
Columns("AL").Hidden = True
Else
Columns("AL").Hidden = False
End If
'
'
'Dim barisakhir3 As Integer
'
'barisakhir3 = Range("G13").Value
'Rows(barisakhir3 & ":65").Select
'Selection.EntireRow.Hidden = True
'
'
''======menyembunyikan kolom yang sisa======
'
'Columns(Range("I13").Value & ":AJ").Select
'Selection.EntireColumn.Hidden = True
'
'
'Columns("U:AJ").Select
' Selection.EntireColumn.Hidden = True
'======mengatur tampilan=======
ActiveWindow.Zoom = 90
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
Application.ScreenUpdating = True
Worksheets("rank").Protect "1", userinterfaceonly:=True
End Sub
Sheet "Raport"
Option Explicit
Private Sub Worksheet_Activate()
Worksheets("raport").Unprotect "1"
If Worksheets("data").Range("P7").Value = "Ganjil" Then
Rows("37:38").EntireRow.Hidden = True
Else
Rows("37:38").EntireRow.Hidden = False
End If
'======mengatur tampilan=======
ActiveWindow.Zoom = 75
ActiveWindow.ScrollColumn = 1
Range("V8").Select
Worksheets("raport").Protect "1", userinterfaceonly:=True
End Sub
Private Sub Worksheet_Calculate()
'======mengatur nomor nama siswa kosong atau jumlah siswa lebih dari yang ada ===========
Worksheets("raport").Unprotect "1"
If Worksheets("raport").Range("V8").Value > Worksheets("raport").Range("W8").Value Then
MsgBox "Tidak Ditemukan Nama Siswa" & vbCrLf & "Silahkan Cek Jumlah Siswa" & vbCrLf & "Nomor lebih dari jumlah siswa", vbOKOnly + vbCritical, "Perhatian"
Range("V8").Value = Worksheets("isinama").Range("G2").Value
End If
If Worksheets("raport").Range("V8").Value <= 0 Then
MsgBox "Tidak Ditemukan Nama Siswa" & vbCrLf & "Silahkan Cek Jumlah Siswa" & vbCrLf & "Nomor urut kurang dari jumlah siswa", vbOKOnly + vbCritical, "Perhatian"
Range("V8").Value = 1
End If
Worksheets("raport").Protect "1", userinterfaceonly:=True
End Sub
Sheet "Sikap"
Private Sub Worksheet_Activate()
Worksheets("sikap").Unprotect "1"
Range("I6:O55").Locked = False
ActiveWindow.Zoom = 85
ActiveWindow.ScrollColumn = 1
Range("I6").Select
Worksheets("sikap").Protect "1", userinterfaceonly:=True
End Sub
Sheet Daftar Hadir
Private Sub Worksheet_Activate()
Worksheets("dafdir").Unprotect "1"
Application.ScreenUpdating = False
'======menyembunyikan baris yang sisa======
Dim barisakhir22 As Byte
Range("11:70").EntireRow.Hidden = False
barisakhir22 = Range("C9").Value
Rows(barisakhir22 & ":63").Select
Selection.EntireRow.Hidden = True
''======menyembunyikan kolom yang sisa======
'
'Columns(Range("I13").Value & ":AJ").Select
'Selection.EntireColumn.Hidden = True
ActiveWindow.Zoom = 90
ActiveWindow.ScrollColumn = 1
Application.ScreenUpdating = True
Range("C11").Select
Worksheets("dafdir").Protect "1", userinterfaceonly:=True
End Sub
Sheet "Isi Nilai"
Private Sub Worksheet_Activate()
Worksheets("isinilai").Unprotect "1"
Application.EnableEvents = True
Range("L8").Select
'======memastikan semuanya kosong=======
Worksheets("isinilai").Range("mapelnilai").ClearContents
'=====copy dari mapelnama ke mapel nilai======
Worksheets("data").Range("L13:L37").Copy
Worksheets("isinilai").Range("mapelnilai").PasteSpecial paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
'=====copy dari namasantri dari sheet "isinama" ke sheet"isinilai" ======
Worksheets("isinama").Range("H4:K53").Copy
Worksheets("isinilai").Range("AY8").PasteSpecial paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("J:AJ").Hidden = True
' Columns("L").Hidden = False
ActiveWindow.Zoom = 85
ActiveWindow.ScrollColumn = 1
'===menentukan cell yang bisa diedit=========
Worksheets("isinilai").Protect "1", userinterfaceonly:=True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Worksheets("isinilai").Unprotect "1"
On Error Resume Next
If Intersect(Target, Range("I4")) Is Nothing Then
Exit Sub
'===memilih mapel dan menyembunyikan kolom yang tidak terpakai ========
'===============================================
ElseIf Range("J4").Value = 1 Then
Columns("J:AJ").Hidden = True
Columns("L").Hidden = False
'========mengatur lebar kolom ==============
Columns("L").EntireColumn.AutoFit
'----------------------------------------------------
ElseIf Range("J4").Value = 2 Then
Columns("J:AJ").Hidden = True
Columns("M").Hidden = False
'========mengatur lebar kolom ==============
Columns("M").EntireColumn.AutoFit
'----------------------------------------------------
ElseIf Range("J4").Value = 3 Then
Columns("J:AJ").Hidden = True
Columns("N").Hidden = False
'========mengatur lebar kolom ==============
Columns("N").EntireColumn.AutoFit
'----------------------------------------------------
ElseIf Range("J4").Value = 4 Then
Columns("J:AJ").Hidden = True
Columns("O").Hidden = False
'========mengatur lebar kolom ==============
Columns("O").EntireColumn.AutoFit
'----------------------------------------------------
ElseIf Range("J4").Value = 5 Then
Columns("J:AJ").Hidden = True
Columns("P").Hidden = False
'========mengatur lebar kolom ==============
Columns("P").EntireColumn.AutoFit
'----------------------------------------------------
ElseIf Range("J4").Value = 6 Then
Columns("J:AJ").Hidden = True
Columns("Q").Hidden = False
'========mengatur lebar kolom ==============
Columns("Q").EntireColumn.AutoFit
'----------------------------------------------------
ElseIf Range("J4").Value = 7 Then
Columns("J:AJ").Hidden = True
Columns("R").Hidden = False
'========mengatur lebar kolom ==============
Columns("R").EntireColumn.AutoFit
ElseIf Range("J4").Value = 8 Then
Columns("J:AJ").Hidden = True
Columns("S").Hidden = False
'========mengatur lebar kolom ==============
Columns("S").EntireColumn.AutoFit
ElseIf Range("J4").Value = 9 Then
Columns("J:AJ").Hidden = True
Columns("T").Hidden = False
'========mengatur lebar kolom ==============
Columns("T").EntireColumn.AutoFit
ElseIf Range("J4").Value = 10 Then
Columns("J:AJ").Hidden = True
Columns("U").Hidden = False
'========mengatur lebar kolom ==============
Columns("U").EntireColumn.AutoFit
ElseIf Range("J4").Value = 11 Then
Columns("J:AJ").Hidden = True
Columns("V").Hidden = False
'========mengatur lebar kolom ==============
Columns("V").EntireColumn.AutoFit
ElseIf Range("J4").Value = 12 Then
Columns("J:AJ").Hidden = True
Columns("W").Hidden = False
'========mengatur lebar kolom ==============
Columns("W").EntireColumn.AutoFit
ElseIf Range("J4").Value = 13 Then
Columns("J:AJ").Hidden = True
Columns("X").Hidden = False
'========mengatur lebar kolom ==============
Columns("X").EntireColumn.AutoFit
ElseIf Range("J4").Value = 14 Then
Columns("J:AJ").Hidden = True
Columns("Y").Hidden = False
'========mengatur lebar kolom ==============
Columns("Y").EntireColumn.AutoFit
ElseIf Range("J4").Value = 15 Then
Columns("J:AJ").Hidden = True
Columns("Z").Hidden = False
'========mengatur lebar kolom ==============
Columns("Z").EntireColumn.AutoFit
ElseIf Range("J4").Value = 16 Then
Columns("J:AJ").Hidden = True
Columns("AA").Hidden = False
'========mengatur lebar kolom ==============
Columns("AA").EntireColumn.AutoFit
ElseIf Range("J4").Value = 17 Then
Columns("J:AJ").Hidden = True
Columns("AB").Hidden = False
'========mengatur lebar kolom ==============
Columns("AB").EntireColumn.AutoFit
ElseIf Range("J4").Value = 18 Then
Columns("J:AJ").Hidden = True
Columns("AC").Hidden = False
'========mengatur lebar kolom ==============
Columns("AC").EntireColumn.AutoFit
ElseIf Range("J4").Value = 19 Then
Columns("J:AJ").Hidden = True
Columns("AD").Hidden = False
'========mengatur lebar kolom ==============
Columns("AD").EntireColumn.AutoFit
ElseIf Range("J4").Value = 20 Then
Columns("J:AJ").Hidden = True
Columns("AE").Hidden = False
'========mengatur lebar kolom ==============
Columns("AE").EntireColumn.AutoFit
ElseIf Range("J4").Value = 21 Then
Columns("J:AJ").Hidden = True
Columns("AF").Hidden = False
'========mengatur lebar kolom ==============
Columns("AF").EntireColumn.AutoFit
ElseIf Range("J4").Value = 22 Then
Columns("J:AJ").Hidden = True
Columns("AG").Hidden = False
'========mengatur lebar kolom ==============
Columns("AG").EntireColumn.AutoFit
ElseIf Range("J4").Value = 23 Then
Columns("J:AJ").Hidden = True
Columns("AH").Hidden = False
'========mengatur lebar kolom ==============
Columns("AH").EntireColumn.AutoFit
ElseIf Range("J4").Value = 24 Then
Columns("J:AJ").Hidden = True
Columns("AI").Hidden = False
'========mengatur lebar kolom ==============
Columns("AI").EntireColumn.AutoFit
ElseIf Range("J4").Value = 25 Then
Columns("J:AJ").Hidden = True
Columns("AJ").Hidden = False
'========mengatur lebar kolom ==============
Columns("AJ").EntireColumn.AutoFit
End If
Worksheets("isinilai").Protect "1", userinterfaceonly:=True
End Sub
Sheet "Isi Nama"
Private Sub Worksheet_Activate()
'====membuka kunci protect=========
Worksheets("isinama").Unprotect "1"
'===menentukan cell yang bisa diedit=========
Range("H4:K53").Locked = False
Range("H3").Select
ActiveWindow.Zoom = 100
ActiveWindow.ScrollColumn = 1
Worksheets("isinama").Protect "1", userinterfaceonly:=True
End Sub
Sheet DKN/Daftar Nilai
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Worksheets("dkn").Unprotect "1"
'=====copy dari isinilai ke dkn======
Worksheets("dkn").Range("G16:AJ65").ClearContents
Worksheets("dkn").Range("sikapdkn").ClearContents
Worksheets("isinilai").Range("G8:AJ57").Copy
Sheets("dkn").Range("G16").Select
Selection.PasteSpecial paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("G16").Select
'=====copy dari isi SIKAP ke dkn======
Worksheets("sikap").Range("sikapsikap").Copy
Sheets("dkn").Range("AP16").Select
Selection.PasteSpecial paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("G16").Select
'======menyembunyikan baris yang sisa======
'
'Dim barisakhir2 As Integer
'
'
'barisakhir2 = Range("G13").Value
'Rows(barisakhir2 & ":65").Select
'Selection.EntireRow.Hidden = True
''======menyembunyikan kolom yang sisa======
'
'Columns(Range("I13").Value & ":AJ").Select
'Selection.EntireColumn.Hidden = True
''========mengatur lebar kolom otomatis==============
ActiveWindow.Zoom = 90
ActiveWindow.ScrollColumn = 1
'ActiveWindow.ScrollRow = -1
Columns("I:AJ").EntireColumn.AutoFit
Columns("AO").EntireColumn.AutoFit
Columns("J:K").Hidden = True
'===menyembunyikan kolom GANJIL TAHUN LALU saat diklik Genap==
If Worksheets("data").Range("P7").Value = "Ganjil" Then
Columns("AL").Hidden = True
Else
Columns("AL").Hidden = False
End If
Application.ScreenUpdating = True
Worksheets("dkn").Protect "1", userinterfaceonly:=True
End Sub
Sheet Cetak DKN/Nilai
Private Sub Eksport_Data_Click()
Worksheets("cetakdkn").Unprotect "1"
Dim WS As Worksheet, WSBaru As Worksheet
Dim namakelas As String
namakelas = Range("E5").Value
Set WS = ThisWorkbook.ActiveSheet
Set WSBaru = Workbooks.Add.ActiveSheet
WS.Range("C8:AM62").Copy
WSBaru.Range("C8").PasteSpecial paste:=xlPasteValues
'===memberi nama sheet hasil eksport===
' ActiveSheet.Name = ThisWorkbook.Name
ActiveSheet.Name = InputBox("Ketik Nama Kelas ", "Hasil Ekspor Data")
On Error Resume Next
'======menghapus kolom yang sisa======
ActiveSheet.Columns(Range("D8").Value & ":AH").Select
Selection.EntireColumn.Delete
'======menghapus baris yang sisa======
Dim barisakhir33 As Byte
barisakhir33 = Range("C8").Value
ActiveSheet.Rows(barisakhir33 & ":60").Select
Selection.EntireRow.Delete
'====hapus tambahan========
ActiveSheet.Rows("1:8").Select
Selection.EntireRow.Delete
ActiveSheet.Columns("A:B").Select
Selection.EntireColumn.Delete
'===menghapus kolom nama wali santri =====
ActiveSheet.Columns("G").Select
Selection.EntireColumn.Delete
ActiveSheet.Rows("1:2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 90
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.RowHeight = 75
Selection.Font.Bold = True
ActiveSheet.Rows("3:3").Select
Selection.Columns.AutoFit
ActiveSheet.Columns("A:C").Select
Selection.ColumnWidth = 2
'====merapikan hasil eksport====
Selection.CurrentRegion.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=MOD(ROW( );2) =0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.799981688894314
End With
Selection.FormatConditions(1).StopIfTrue = False
' Application.ThisWorkbook.Sheets(1).Name
'===memberi pesan sudah berhasil=======
' MsgBox "Data berhasil diekspor", vbOKOnly + vbInformation, "Hasil Export"
' ActiveSheet.Range("A1").Select
'===#############################====
WSBaru.SaveAs ThisWorkbook.Path & "\Hasil Ekspor Kls-" & ActiveSheet.Name, 51
'50 untuk save format *.xlsb, 51 untuk save format *.xlsx, 52 untuk save format *.xlsm
ActiveWorkbook.Close savechanges:=False
MsgBox "Data berhasil diekspor", vbOKOnly + vbInformation, "Info"
' Application.ScreenUpdating = True
' Application.EnableEvents = True
' Application.Calculation = xlCalculationManual
Worksheets("cetakdkn").Protect "1", userinterfaceonly:=True
End Sub
Private Sub Worksheet_Activate()
Worksheets("cetakdkn").Unprotect "1"
Application.ScreenUpdating = False
ActiveWindow.View = xlNormalView
'=========copy_rank_ke_cetakDKN Macro
Worksheets("cetakdkn").Range("D11:AH60").ClearContents
Worksheets("rank").Range("F16:AJ65").Copy
Worksheets("cetakdkn").Range("D11").Select
Selection.PasteSpecial paste:=xlPasteValues
'========mengatur lebar kolom ==============
Columns("G:AH").EntireColumn.AutoFit
Columns("AJ:AT").EntireColumn.AutoFit
Columns("AM").ColumnWidth = 17
'Columns("AN:AT").EntireColumn.AutoFit
Columns("H:I").Hidden = True
Columns("AN:AT").Hidden = True
On Error Resume Next
'===menyembunyikan kolom GANJIL TAHUN LALU saat diklik Genap==
If Worksheets("data").Range("P7").Value = "Ganjil" Then
Columns("AJ").Hidden = True
Else
Columns("AJ").Hidden = False
End If
'======menyembunyikan kolom yang sisa======
Columns(Range("D8").Value & ":AH").Select
Selection.EntireColumn.Hidden = True
'Columns("U:AJ").Select
' Selection.EntireColumn.Hidden = True
'======menyembunyikan baris yang sisa======
Dim barisakhir33 As Byte
Range("D11:D62").Select
Selection.EntireRow.Hidden = False
barisakhir33 = Range("C8").Value
Rows(barisakhir33 & ":60").Select
Selection.EntireRow.Hidden = True
Range("C11").Select
ActiveWindow.Zoom = 75
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
Application.ScreenUpdating = True
Worksheets("cetakdkn").Protect "1", userinterfaceonly:=True
End Sub
Langganan:
Postingan (Atom)