Aqil Macro: Oktober 2021

Sabtu, 30 Oktober 2021

Conditional Formating

=MOD(ROW();2)=1

Range Dinamis


=OFFSET(isinilai!$I$6;2;3;COUNT(isinilai!$G$8:$G$57);COUNT(isinilai!$I$6:$AJ$6))

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

Sheet Rata-Rata Ganjil


Private Sub Worksheet_Activate()
Worksheets("rtganjil").Unprotect "1"






'Range("G11").Select

'ActiveWindow.Zoom = 95
'ActiveWindow.ScrollColumn = 1


Worksheets("rtganjil").Protect "1", userinterfaceonly:=True



End Sub

Sheet "Data"




Private Sub cmdreset_Click()
Dim tombol As Byte
Dim tombol2 As Byte
Dim tombol3 As Byte
ActiveWindow.View = xlNormalView





tombol = MsgBox("Apakah anda ingin benar-benar menghapus data.....??" + vbCrLf + _
"Tindakan ini menyebabkan" + vbCrLf + "DATA MAPEL, NAMA SISWA dan NILAI SISWA" + vbCrLf + "di file raport ini akan DIKOSONGKAN", vbOKCancel + vbQuestion, "PERHATIAN")

If tombol = 1 Then
    tombol2 = MsgBox("Saya ingatkan sekali lagi" + vbCrLf + "Apakah anda benar-benar ingin" + vbCrLf + "Menghapus SEMUA DATA....??", vbOKCancel + vbQuestion, "PENTING")
    If tombol2 = 1 Then
    Worksheets("data").Range("H13:H37").ClearContents
    Worksheets("isinama").Range("H4:K53").ClearContents
    Worksheets("isinilai").Range("L8:AJ57").ClearContents
    Worksheets("rtganjil").Range("G11:G60").ClearContents
    Worksheets("sikap").Range("I6:O55").ClearContents
    cmdreset.Visible = False
    tombol3 = MsgBox("Semua Data telah berhasil DIHAPUS", vbInformation + vbOKOnly, "Informasi")
    Else
    Range("A1").Select
    cmdreset.Visible = False
    End If
Else
Range("A1").Select
cmdreset.Visible = True
End If





End Sub


Private Sub Worksheet_Activate()
Worksheets("data").Unprotect "1"

'SendKeys "{ESC}"
ActiveWindow.Zoom = 100
ActiveWindow.ScrollColumn = 1
Range("H13").Select


Worksheets("data").Protect "1", userinterfaceonly:=True




End Sub

Rabu, 27 Oktober 2021

Do While Loop - buka file yang ada dalam folder


Option Explicit
Sub test()

Dim fileku As String, lokasi As String

lokasi = "D:\Raport Nafa\"
fileku = Dir(lokasi & "*.xlsm")

Do While fileku <> ""
Workbooks.Open lokasi & fileku
fileku = Dir()
Loop

End Sub

Do While Loop

Option Explicit
Sub test()

Dim hitung As Integer
hitung = 1
Do While hitung <= 5
MsgBox "Saya hitung ya " & hitung, vbOKOnly, "info"
hitung = hitung + 1
Loop
End Sub

For Each in next - Menutup Workbook Yang Terbuka

Option Explicit
Sub nutup()

Dim wb As Workbook

For Each wb In Workbooks
If wb.Name <> ThisWorkbook.Name Then
wb.Close
End If
Next wb
End Sub

===================================

Sub nutup()

Dim ws As Worksheet

For Each ws In Worksheets
ws.Visible = xlSheetVisible

Next ws
End Sub

Selasa, 26 Oktober 2021

Membandingkan Dua Data

=IF(ISERROR(MATCH(A1,$C$1:$C$5,0)),"",A1)

For Next

Sub test()

Dim i As Integer
For i = 1 To 5

Worksheets.Add
Next i

End Sub
---------------------------------

'kombinasi dengan inputbox

Sub test()
Dim i As Integer
Dim jumlah As Integer

jumlah = InputBox("Masukkan jumlah sheet yang mau ditambahkan?", "Tambah")

For i = 1 To jumlah
Worksheets.Add
Next i


End Sub
----------------------------------


Sub test()
Dim i As Integer
Dim jumlah As Variant

jumlah = InputBox("Masukkan jumlah baris yang akan disembunyikan?", "Jumlah Baris")

If jumlah = "" Then
Exit Sub
End If

For i = 4 To jumlah
Rows(i).Hidden = True
Next i

End Sub

------------------------

Input Box

Sub test()

jumlah = InputBox("Masukkan nilai yang anda peroleh ?", "Perolehan Nilai")

If jumlah = "" Or Val(jumlah) < 1 Then

MsgBox "Tolong masukkan nilai selain nol"
Else
MsgBox "Anda termasuk kategori LULUS"

End If

End Sub

-------------------------------------
Sub test()

pass = InputBox("Masukkan password anda ?", "Password")

If pass = "" Then

MsgBox "Tolong masukkan Password"
ElseIf pass = "aku" Then
MsgBox "SUKSES LOGIN"
Else
MsgBox "MAAF!! Anda tidak berhak masuk"

End If

End Sub

Select Case

Sub test()
Dim hari As Byte

hari = Weekday(VBA.Date)

Select Case hari
Case 1
MsgBox "Hari Ahad"
Case 2
MsgBox "Hari Senin"
Case 3
MsgBox "Hari Selasa"
Case 4
MsgBox "Hari Rabu"
Case 5
MsgBox "Hari Kamis"
Case 6
MsgBox "Hari Jum'at"
Case 7
MsgBox "Hari Sabtu"
Case 8, 9
MsgBox "Hari ini LIBUR"
End Select



End Sub
----------------------------------------------------


Sub test()
Dim hari As Byte

hari = Month(VBA.Date)

Select Case hari
Case 1 To 5: MsgBox "Semester gasal"
Case 1 To 9: MsgBox "semester ganjil"
Case 10: MsgBox "Bulan Oktober"
End Select

End Sub

--------------------------------------------------------


Sub test()
Dim hari As Byte

jumlah = Range("A1").Value


Select Case jumlah
Case Is <= 50: MsgBox "Anda GAGAL TOTAL"
Case Is <= 99: MsgBox "Anda MAKBUL"
Case Is = 100: MsgBox "Anda MUMTAZ"
End Select

End Sub


--------------------------------------------------------
Sub test()


Select Case MsgBox("Apakah anda ingin mengcopy sheet saat ini?", vbYesNo + vbInformation, "Info")

Case vbNo
MsgBox "Ok gak masalah"
Exit Sub
Case vbYes
MsgBox "Bagus..! Terima kasih atas konfirmasinya"
ActiveSheet.Copy before:=ActiveSheet
End Select
End Sub

IIF

Sub test()
Dim hari As Byte

hari = Weekday(VBA.Date)

MsgBox IIf(hari = 3, "sekarang hari Selasa", "rabu")


End Sub

Menentukan Hari Sekarang Berdasarkan Angka

Sub test()
Dim hari As Byte

hari = Weekday(VBA.Date)

If hari = 1 Then
MsgBox "Ahad"
ElseIf haari = 2 Then
MsgBox "Senin"
ElseIf hari = 3 Then
MsgBox "Selasa"
Else
MsgBox "rabu"
End If

End Sub

Grid

ActiveWindow.DisplayGridlines = False

Serba Awal


Sub test()

'mencari baris paling awal dari semuanya,hasilnya angka

barisawal = Cells.Find(What:="*", searchdirection:=xlNext, _
searchorder:=xlByRows).Row

kolomawal = Cells.Find(What:="*", searchdirection:=xlNext, _
searchorder:=xlByColumns).Column

MsgBox "Baris awal " & barisawal & vbCrLf & "kolom awal " & kolomawal
End Sub

Serba Akhir

Sub test()

'mencari baris yang terakhir dari total semuanya, hasil berupa angka
barisakhir = Cells.Find(What:="*", After:=Range("A1"), _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

MsgBox barisakhir
End Sub
-----------------------


Sub test()

'mencari baris yang terakhir, hasil berupa angka, kolom ke-4
barisakhirsatukolom = Cells(Rows.Count, 4).End(xlUp).Row
MsgBox barisakhirsatukolom
End Sub


-------------------
Sub test()

'mencari baris yang terakhir, dari beberapa kolom
barisakhirbeberapakolom = Range("B:D").Find(What:="*", After:=Range("B1"), _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
MsgBox barisakhirbeberapakolom
End Sub

-------------------------
Sub test()

'kolom akhir dari semua baris,keluar angka, hasilnya kolom ke-8
kolomakhir = Cells.Find(What:="*", After:=Range("A1"), _
SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

MsgBox kolomakhir
End Sub

Senin, 25 Oktober 2021

Used Range


Sub test()


ActiveSheet.UsedRange.Select


End Sub

Address



Sub test()


Dim barisakhir As Long
Dim kolomakhir As Long

barisakhir = Cells.Find(what:="*", searchdirection:=xlPrevious, searchorder:=xlByRows).Row

kolomakhir = Cells.Find(what:="*", searchdirection:=xlPrevious, searchorder:=xlByColumns).Column

Range("C3").Resize(barisakhir, kolomakhir).Select

MsgBox "Data yang terblok beralamat pada " & Selection.Address(0, 0), vbInformation, "Ok"


End Sub

Ngeblok sejumlah Baris dan Kolom Akhir



Sub test()


Dim barisakhir As Long
Dim kolomakhir As Long

barisakhir = Cells.Find(what:="*", searchdirection:=xlPrevious, searchorder:=xlByRows).Row

kolomakhir = Cells.Find(what:="*", searchdirection:=xlPrevious, searchorder:=xlByColumns).Column

Range("C3").Resize(barisakhir, kolomakhir).Select

End Sub

Seleksi dengan Resize

Sub test() Range("C3").Resize(4, 3).Select 'jika resize ngeblok sesaui dengan jumlah kolom dan baris dg C3 sebagai acuan End Sub

Seleksi Dengan Offset

Sub test() Range(ActiveCell, ActiveCell.Offset(5, 2)).Select 'kalau offset dimulai dari nol End Sub

Seleksi Beberapa Cell Sekaligus

Sub test() Range("A3, D5, F1:F4").Select End Sub

Current Region


sub test()

ActiveCell.CurrentRegion.Select


'catatan : datanya harus nempel/nyambung, sehingga bisa diseleksi, salah satu cell harus aktif di data tersebut
End Sub

Seleksi Baris Akhir

Sub test() barisakhir = Cells(Rows.Count, 2).End(xlUp).Row Range(Cells(2, 2), Cells(barisakhir, 2)).Select End Sub

Posisi dan Select Range

Sub test() Cells(2, 4).Font.Bold = True Cells(2, "E").Font.Bold = False Range(Cells(3, 4), Cells(4, 5)).Select End Sub

Baris Akhir dan Kolom Akhir

Sub test()
Dim jumlahbaris As Long
Dim jumlahkolom As Long

jumlahbaris = Cells(Rows.Count, 2).End(xlUp).Row
jumlahkolom = Cells(2, Columns.Count).End(xlToLeft).Column

MsgBox "jumlah baris adalah : " & jumlahbaris & vbCrLf & "Jumlah kolom : " & jumlahkolom, vbokonlny + vbInformation, _
"Info"


End Sub

Kamis, 21 Oktober 2021

Backup File

Option Explicit

Sub backup()

ThisWorkbook.SaveCopyAs Filename:=ThisWorkbook.Path & "\" & _

Format(Date, "dd-mmmm-yyyy") & " hasil " & Sheets(1).Range("B2").Value

'=====atau ThisWorkbook.Name

End Sub

Buka File

Option Explicit

Sub import()

Dim bukafile As Variant

bukafile = Application.GetOpenFilename(FileFilter:="Excel Workbooks,*.xl*", _

Title:="Pilih file yang akan diimport", _

MultiSelect:=False)

If bukafile <> False Then

Workbooks.Open Filename:=bukafile

End If

End Sub

Peringatan Menyimpan Sebelum Menutup File

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Select Case MsgBox("Apakah anda ingin menyimpan file ini?", vbOKCancel + vbQuestion, "informasi")

Case Is = vbCancel

Cancel = True

Case Is = vbOK

ActiveWorkbook.Save

End Select

End Sub

Worksheet Change

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("A1")) Is Nothing Then

Exit Sub

ElseIf Range("A1").Value = 1 Then

Columns("A:K").Hidden = False

Columns("E").Hidden = True

ElseIf Range("A1").Value = 2 Then

Columns("A:K").Hidden = False

Columns("F").Hidden = True

Else

Columns("A:K").Hidden = False

End If

End Sub

Rabu, 20 Oktober 2021

Immediate

?worksheets.count

========================

selection.offset (15,0).select

=======================

selection.copy

selection.offset (2,0).select

activesheet.paste

Do While Jika Tidak Sama Dengan Kosong

Public Sub ExampleDoWhileCalcLoop()

Dim i As Integer

i = 5

Do While Cells(i, 2) <> ""

Cells(i, 3).Value = Cells(i, 2).Value + 30

i = i + 1

Loop

============================

Public Sub DoUntilLoopEx()

Dim i As Integer

i = 1

Do Until IsEmpty(Cells(i, 1))

Cells(i, 1).Value = "info"

i = i + 1

Loop

=============================

Public Sub DoLoopUNTIL()

Dim i As Integer

i = 1

Cells(i, 1).Value = "farmasi"

i = i + 1

Loop Until IsEmpty(Cells(i, 1))

Eksport Nilai

Sub export()

Range("C4:P19").Copy

Workbooks.Add Range("B2").Select

ActiveSheet.Paste

'===memberi nama sheet hasil eksport===

Sheets(1).Name = InputBox("Ketik nama Sheet hasil eksport", "Eksport Data")

On Error Resume Next

Application.ThisWorkbook.Sheets(1).Name

'===menghapus kolom yang kosong===

Rows("4").Select

Selection.SpecialCells(xlCellTypeBlanks).Select

Selection.EntireColumn.Delete

'===menghapus baris yang kosong===

Columns("C").Select

Selection.SpecialCells(xlCellTypeBlanks).Select

Selection.EntireRow.Delete

'===memberi pesan sudah berhasil=======

MsgBox "Data berhasil diexport", vbOKOnly + vbInformation, "Hasil Export"

Range("A1").Select

End Sub

Selasa, 19 Oktober 2021

Exit For

Public Sub ExitForExample()

Dim x As Byte

For x = 1 To 50
Range("B" & x).Select
    If Range("B" & x).Value = "Stop" Then
    Exit For
    ElseIf Range("B" & x).Value = "" Then
    Range("B" & x).Value = "info"
    End If
Next x

Rabu, 13 Oktober 2021

Ranking

=RANK(AG6;AG$6:AG$32;0)+COUNTIF($AG$5:AG5;AG6)

Home

Sabtu, 30 Oktober 2021

Rabu, 27 Oktober 2021

Selasa, 26 Oktober 2021

Senin, 25 Oktober 2021

Kamis, 21 Oktober 2021

Rabu, 20 Oktober 2021

Selasa, 19 Oktober 2021

Rabu, 13 Oktober 2021