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
Sabtu, 30 Oktober 2021
Sheet Cetak DKN/Nilai
Langganan:
Posting Komentar (Atom)
Menghitung USIA Excel
=BYROW(D2:D100; LAMBDA(tanggal_lahir; IF(tanggal_lahir=""; ""; DATEDIF(tanggal_lahir; TODAY(); "y"...
-
Option Explicit Private Sub hasilpencariangabung() Dim gabung As Range Set gabung = Sheet8.Range("A4") gabung.CurrentRegion.Cl...
-
=BYROW(D2:D100; LAMBDA(tanggal_lahir; IF(tanggal_lahir=""; ""; DATEDIF(tanggal_lahir; TODAY(); "y"...
-
Option Explicit Sub import() Dim bukafile As Variant bukafile = Application.GetOpenFilename(FileFilter:="Excel Workbooks,*.xl*", ...
Tidak ada komentar:
Posting Komentar