Vba Excel: Isyarat Vba Sebaran Tanggal Kalender Dan Pewarnaannya

VBA atau Visual Basic for Applications untuk Microsoft Excel ini merupakan bahasa pemograman yang gampang diterapkan dalam mengoperasikan di Excel. Sudah banyak pengguna Excel yang menerapkan arahan ini untuk aneka macam keperluan.

Sebagaimana yang sudah diketahui, Excel mempunyai 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 alasannya ialah itu, sedikit aku beberkan informasi mengenai salah satu arahan dalam pembuatan kalender dengan memakai visual basic di microsoft excel. Kode ini aku terapkan di aplikasi excel buatan aku yang berbasis vba.

Asumsikan bahwa teladan 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 ibarat ini:

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

Koding pemanggilnya:

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

    


Berikut arahan 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 arahan VBA untuk pembuatan kalender. Semoga bermanfaat.

Share this post