√ Menciptakan Kalender Sepanjang Hayat Di Excel 2010

Menjelang final tahun tentu beberapa orang khusus di bidang percetakan biasanya disibukan dengan pembuatan kalender. Nah bagi para pengguna Excel tentu hal ini juga sanggup dibentuk dan hebatnya lagi kalender ini sanggup dipakai sepanjang hayat tanpa batas waktu. Pembuatan kalender ini memakai beberapa rumus excel dan dikolaborasikan dengan VBA. Ok, pribadi saja ini ia tampilan dari kalender sepanjang hayat tersebut.

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

Langkah berikutnya yaitu kita akan menciptakan sctipr VBA dan untuk mempermudah dalam pembuatan silakan copy paste kan script berikut ini pada module1 untuk cara menciptakan module sudah pernah aku 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 menciptakan rumus pada sheet Calendar dan silakan ikuti petunjuk rumus dibawah ini

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

Jika sudah selesai langkah berikutnya yaitu kita akan menciptakan perintah kalau 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 menciptakan kiprah 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 kiprah pada tanggal 8 yang telah aku double klik. Silakan tuliskan contohnya pada kotak Enter Task dituliskan "Peringatan hari jadi Excel" lalu klik OK.

Demikian bagaimana cara menciptakan kalender sepanjang hayat pada Excel 2010. Semoga bermanfaat dan selamat mencoba.
Sumber http://www.excel-id.com/