VBA 学习记录 20181103——初识VBA宏编辑

在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