Membuat Kalender Sepanjang Hayat di Excel 2010

Menjelang akhir tahun tentu beberapa orang khusus di bidang percetakan biasanya disibukan dengan pembuatan kalender. Nah bagi para pengguna Excel tentu hal ini juga bisa dibuat dan hebatnya lagi kalender ini dapat digunakan sepanjang hayat tanpa batas waktu. Pembuatan kalender ini menggunakan beberapa rumus excel dan dikolaborasikan dengan VBA. Ok, langsung saja ini dia tampilan dari kalender sepanjang hayat tersebut.

Bagaimana cara membuat kalender sepanjang hayat pada excel 2010? berikut tutorialnya :
Langkah pertama pada sheet3 silakan buat tulisan seperti berikut ini dan ketikkan rumus di cell C1 dengan formula =B1+QUOTIENT(B2-1;12) kemudian di cell C2 tuliskan rumus =IF(MOD(B2;12)=0;12;MOD(B2;12))

Langkah berikutnya adalah kita akan membuat sctipr VBA dan untuk mempermudah dalam pembuatan silakan copy paste kan script berikut ini pada module1 untuk cara membuat module sudah pernah saya bahas sebelumnya.

Sub Year_Increase()
Range("Sheet3!B1").Value = Range("Sheet3!B1").Value + 1
Call datehighlight
End Sub

Sub Year_Decrease()
Range("Sheet3!B1").Value = Range("Sheet3!B1").Value - 1
Call datehighlight
End Sub

Sub Month_Increase()
Range("Sheet3!B2").Value = Range("Sheet3!B2").Value + 1
Call datehighlight
End Sub

Sub Month_Decrease()
Range("Sheet3!B2").Value = Range("Sheet3!B2").Value - 1
Call datehighlight
End Sub


Sub datehighlight()

Dim MonthDates As Range
Dim MonthDatesinComments As Range
Dim CommentDateCheck As Date

Set MonthDates = Range("B7:H12")
If Comments.Range("B3") <> "" Then
Set MonthDatesinComments = Comments.Range("B3", Comments.Range("B3").End(xlDown))
End If
If Comments.Range("C3").Value <> "" Then
    For Each cell In MonthDates
    If cell.Value <> "" Then
        If MonthDatesinComments.Find(DateValue(Range("E3").Value & " " & cell.Value & "," & Range("E2").Value), LookAt:=xlWhole) Is Nothing Then
            cell.Font.Color = vbBlack
        Else:
        cell.Font.Color = vbBlue
        End If
    End If
    Next cell
Else:
For Each cell In MonthDates
cell.Font.Color = vbBlack
Next cell
End If

End Sub

Sub GetMonthlyList()
Dim MonthlyList As String
Dim Findvalue As String

Dim MonthDates As Range
Dim MonthDatesinComments As Range
Dim I As Integer
Dim J As Integer
Dim MonthDatesValues As Date
Set MonthDates = Range("B7:H12")
Set MonthDatesinComments = Comments.Range("B3", Comments.Range("B3").End(xlDown))
If Comments.Range("B3").Value <> "" Then
    For Each cell In MonthDates
    If cell.Value <> "" Then
        MonthDatesValues = DateValue(Range("E3").Value & " " & cell.Value & " " & Range("E2"))
        If Comments.Range("B3") = "" Then J = 0 Else
        J = Comments.Range("B2", Comments.Range("B2").End(xlDown)).Count - 1
        End If
        For I = 0 To J - 1
            If cell.Value <> "" Then
            If MonthDatesValues = Comments.Range("B3").Offset(I, 0) Then
            MonthlyList = MonthlyList & Day(MonthDatesValues) & "-" & MonthName(Month(MonthDatesValues), True) & ": " & Comments.Range("B3").Offset(I, 1).Value & vbNewLine
            End If
            End If
        Next I
        Next cell
    End If
    MsgBox MonthlyList
End Sub

Langkah ke-3 kita akan membuat rumus pada sheet Calendar dan silakan ikuti petunjuk rumus dibawah ini

1. cell E2 silakan ketikkan rumus =Sheet3!C1
2. cell E3 silakan ketikkan rumus =TEXT(DATE(E2;Sheet3!C2;1);"mmm")
3. cell B5 silakan ketikkan rumus =TEXT(DATE(E2;Sheet3!C2;1);"mmmm")&" "&E2
4. cell B7 silakan ketikkan rumus =IF(WEEKDAY(DATE(Sheet3!C1;Sheet3!C2;1);2)=COLUMNS($B$7:B7);1;IF(ISNUMBER(A7);A7+1;"")) kemudian copy kan ke kanan
5. cell B8 silakan ketikkan rumus =IF(H7<DAY(DATE(Sheet3!$C$1;Sheet3!$C$2+1;1)-1);H7+1;"") kemudian copy kan ke bawah

Jika sudah selesai langkah berikutnya adalah kita akan membuat perintah jika cell di double klik silakan copy kan script berikut pada sheet2 (calendar)

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = False
Dim Comment As Variant
Dim CommentDate As Date

If Target.Row > 6 And Target.Row < 13 And Target.Column > 1 And Target.Column < 9 Then
Cancel = True
If Target.Value <> "" Then
Comment = Application.InputBox("Enter Task")
If Comment = False Then Exit Sub
CommentDate = Target.Value & " " & Range("E3").Value & " " & Range("E2").Value
If Sheets("Comments").Range("C3") <> "" Then
Sheets("Comments").Range("C2").End(xlDown).Offset(1, 0) = Comment
Else: Sheets("Comments").Range("C3") = Comment
End If
If Sheets("Comments").Range("B3") <> "" Then
Sheets("Comments").Range("B2").End(xlDown).Offset(1, 0) = CommentDate
Else: Sheets("Comments").Range("B3") = CommentDate
End If
End If
End If
Call datehighlight
End Sub

Dari script diatas akan memanggil komentar untuk membuat tugas pada tanggal yang di double klik maka silakan untuk menguji coba double klik salah satu tanggal pada kalender tersebut maka akan muncul pesan berikut ini

Gambar yang ditunjukan oleh anak panah warna hijau memerintahkan Anda untuk memasukan tugas pada tanggal 8 yang telah saya double klik. Silakan tuliskan misalnya pada kotak Enter Task dituliskan "Peringatan hari jadi Excel" kemudian klik OK.

Demikian bagaimana cara membuat kalender sepanjang hayat pada Excel 2010. Semoga bermanfaat dan selamat mencoba.

Tweet