在EXCEL中生成一个年历
Sub DateList()
’ show a InputMessageBox to Input a YearNumeric by User
'y = InputBox(“Input a year please”, “year”, Year(Date), , , , 1)
y = Application.InputBox(“Input a year please”, “year”, Year(Date), , , , , 1)
’ if Input an empty value show a message then show inputbox
If y = False Then
MsgBox “Please intput a numberic”
Call DateList
Exit Sub
End If
’ if Input Value isnot a numeric show a message then show inputbox
If Not VBA.IsNumeric(y) Then
MsgBox “Please intput a numberic”
Call DateList
Exit Sub
End If
If Len(y) <> 4 Then
MsgBox “Please intput a year numberic”
Call DateList
Exit Sub
End If
Range(“1:1,4:11,14:21,24:31,34:41”).ClearContents
'set title
Range(“A1:W1”).Merge
Cells(1, 1) = y & “擭”
Range(“A1:W1”).Borders.ColorIndex = 5
Range(“A1:W1”).HorizontalAlignment = Excel.xlCenter
With Range(“A1:W1”).Font
.Bold = True
.Name = “HGS嫵壢彂懱”
.Size = 20
End With
’
Dim dm As Variant
dm = Array(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
If ((y Mod 400 = 0) Or (y Mod 4 = 0 And y Mod 100 <> 0)) Then
dm(1) = 29
End If
For m = 0 To 11
’ get the firstday in the first is which day in this week
d = DateSerial(y, m + 1, 1)
w = Weekday(d)
r = (m \ 3) * 10 + 4
c = (m Mod 3) * 8
Range(Cells(r - 2, c + 1), Cells(r - 2, c + 7)).Merge
Range(Cells(r - 2, c + 1), Cells(r - 2, c + 7)).Borders.ColorIndex = 3
Range(Cells(r - 2, c + 1), Cells(r - 2, c + 7)) = (m + 1) & “寧”
Range(Cells(r - 2, c + 1), Cells(r - 2, c + 7)).HorizontalAlignment = Excel.xlCenter
Range(Cells(r - 2, c + 1), Cells(r - 2, c + 7)).Interior.Color = RGB(255, 0, 255)
For diw = 1 To 7
Cells(r - 1, c + diw) = “惎婜” & Application.Text(diw, “[DBNum1]”)
With Cells(r - 1, c + diw)
.Interior.Color = RGB(30, 140, 66)
.Borders.ColorIndex = 5
.HorizontalAlignment = Excel.xlRight
End With
Next
For d = 1 To dm(m)
Cells(r, c + w) = d
w = w + 1
If w > 7 Then
w = 1
r = r + 1
End If
Next
Next
End Sub