VBA Excel: Kode VBA sebaran tanggal kalender dan pewarnaannya

VBA atau Visual Basic for Applications untuk Microsoft Excel ini merupakan bahasa pemograman yang mudah diterapkan dalam mengoperasikan di Excel. Sudah banyak pengguna Excel yang menerapkan kode ini untuk berbagai keperluan.

Sebagaimana yang sudah diketahui, Excel memiliki formula untuk memudahkan penggunanya dalam mengoperasikan angka-angka atau data. Selain formula, hampir semua aplikasi microsoft didukung oleh pemograman visual basic ini.

Baca juga: Semua tutorial microsoft Excel yang ada di blog ini

Oleh karena itu, sedikit saya beberkan informasi mengenai salah satu kode dalam pembuatan kalender dengan menggunakan visual basic di microsoft excel. Kode ini saya terapkan di aplikasi excel buatan saya yang berbasis vba.

Asumsikan bahwa acuan bulan pada tiap kolom kalender itu ada di sel K5. Kemudian sebaran tanggalnya berada pada sel J7:P12, Koding pemanggilnya adalah:

    Call sebarinTgl(Range("K5"), Range("J7:P12"))

Koding ini ditaruh pada module

    Sub sebarinTgl(julidate As Range, AreaYgDiwarnai As Range)
    Dim csheet As Worksheet
    Dim rng As Range
    Dim firstKol, firstrow As String
    Dim fTgl, lTgl, PtkTgl As Date
    Dim julcol, julrow, firstT As String
    Dim fjul, ljul As Date
    Dim x As Integer
   
    Set csheet = ThisWorkbook.ActiveSheet

    AreaYgDiwarnai.ClearContents
    AreaYgDiwarnai.Borders.LineStyle = xlNone
    AreaYgDiwarnai.Interior.Color = xlNone

    If Weekday(julidate) = 1 Then firstKol = AreaYgDiwarnai(1).Column
    If Weekday(julidate) = 2 Then firstKol = AreaYgDiwarnai(2).Column
    If Weekday(julidate) = 3 Then firstKol = AreaYgDiwarnai(3).Column
    If Weekday(julidate) = 4 Then firstKol = AreaYgDiwarnai(4).Column
    If Weekday(julidate) = 5 Then firstKol = AreaYgDiwarnai(5).Column
    If Weekday(julidate) = 6 Then firstKol = AreaYgDiwarnai(6).Column
    If Weekday(julidate) = 7 Then firstKol = AreaYgDiwarnai(7).Column

    fjul = DateSerial(Year(julidate), Month(julidate), 1)
    ljul = CDate(Application.WorksheetFunction.EoMonth(julidate, 0))

    julrow = AreaYgDiwarnai.Row

    If Weekday(fjul) = 1 Then
        julcol = AreaYgDiwarnai(1).Column
    ElseIf Weekday(fjul) = 2 Then
        julcol = AreaYgDiwarnai(2).Column
    ElseIf Weekday(fjul) = 3 Then
        julcol = AreaYgDiwarnai(3).Column
    ElseIf Weekday(fjul) = 4 Then
        julcol = AreaYgDiwarnai(4).Column
    ElseIf Weekday(fjul) = 5 Then
        julcol = AreaYgDiwarnai(5).Column
    ElseIf Weekday(fjul) = 6 Then
        julcol = AreaYgDiwarnai(6).Column
    ElseIf Weekday(fjul) = 7 Then
        julcol = AreaYgDiwarnai(7).Column
    End If
    

    For x = 1 To Day(ljul)
        If firstT = Empty Then
            csheet.cells(julrow, julcol) = fjul
            firstT = 1
            csheet.cells(julrow, julcol).NumberFormat = "[$-421] d"
            csheet.cells(julrow, julcol).Borders.LineStyle = xlContinuous
        Else
            fjul = fjul + 1
            csheet.cells(julrow, julcol) = fjul
            csheet.cells(julrow, julcol).NumberFormat = "[$-421] d"
            csheet.cells(julrow, julcol).Borders.LineStyle = xlContinuous
            End If

        If julcol = AreaYgDiwarnai(7).Column Then
            julcol = AreaYgDiwarnai(1).Column
            julrow = julrow + 1
        Else
            julcol = julcol + 1
        End If
    Next x
    End Sub

Sedangkan untuk menandai warna sesuai tanggalnya, Silakan sesuaikan formatnya seperti ini:

Penjelasannya: Kolom yang berisi keterangan, kolom tanggal "dari Tanggal", sampai kolom "sampai tanggal" menandakan berapa banyak hari libur tersebut. Pada kolom warna akan, nantinya tanggal yang sama dari tanggal hingga sampai tanggal pada isian ini akan otomatis berwarna seperti warna pada kolom "tanda warna".

Koding pemanggilnya:

    Call TandaWarna(Range("C6:C50"), Range("D6:D50"), Range("F6:F50"), Range("J7:AN12"))

    


Berikut kode yag ditaruh di module:

    Sub TandaWarna(TglAwal As Range, TglAkhir As Range, KolomWarna As Range, AreaYgDiwarnai As Range)
    Dim rng As Range
    Dim lAkhir As Long
    Dim lanjut As Label

    'hapus dulu warna yang ada
    AreaYgDiwarnai.Interior.Color = xlNone

    For Each rng In AreaYgDiwarnai
        For i = 1 To TglAwal.Rows.Count
            If TglAwal(i) = "" Then GoTo lanjut
             If TglAkhir(i) <> "" Then
                lAkhir = TglAkhir(i)
            Else
                lAkhir = TglAwal(i)
            End If

            For l = TglAwal(i) To lAkhir
                If rng.Value = l Then
                    rng.Interior.Color = KolomWarna(i).Interior.Color
                End If

            Next l

    lanjut:
        Next i
        If Weekday(rng) = 1 Then rng.Interior.Color = vbRed
        If rng = Empty Then rng.Interior.ColorIndex = Range("w3").Interior.ColorIndex
    Next rng
    
    End Sub

Itulah beberapa kode VBA untuk pembuatan kalender. Semoga bermanfaat.