Sabtu, 30 Oktober 2021

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




Tidak ada komentar:

Posting Komentar

Menghitung USIA Excel

=BYROW(D2:D100; LAMBDA(tanggal_lahir;     IF(tanggal_lahir=""; "";         DATEDIF(tanggal_lahir; TODAY(); "y"...