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"...
-
Salin ke Clipboard Salin ke Clipboard Salin Tercopy! ...
-
=MOD(ROW();2)=1
-
Option Explicit Private Sub Workbook_BeforeClose(Cancel As Boolean) Select Case MsgBox("Apakah anda ingin menyimpan file ini?", v...
Tidak ada komentar:
Posting Komentar