VBA中有些日历控件,使用起来并不十分友好,而且日期控件不是默认启用,所以一般的使用者并不知道如何使用。
通过一些努力,依据简单的默认控件,制作了一个日历选择控件,很好用。
日历的难点在于,如何对日期类型进行处理,特别是不同月份天数也不同,这样就对日期天数判定要有一个处理。
根据不同年份给出不同月份的天数,然后转换为相应的控件,显示出来。
还对控件赋予相应的功能,如单击日期将选定日期复制到工作表中。
还有就是动态显示效果的处理,当鼠标滑动到控件上时有一个动画效果,按下之后还有一个不同的动态效果,主要是颜色改变。
上图为选择日期后赋值到工作表的效果。
下面看一下整体日期对话框效果。
日期中的月份和年份单击不同的三角剪头来进行滚动,滚动后日历也随着改变。
调用方法就是在工作表中双击单元格即可,当然了,也可以通过其它方法来进行调用,这个就看自己的需要了,整体移植性还可以,没有什么不可以。
代码:
Private Sub SetHotDay() '设置当前日期
Dim xObj As Object
For Each xObj In Me.Controls
If VBA.Left(xObj.Tag, 1) = "D" Then
If VBA.Len(VBA.Trim(xObj.Caption)) <> 0 Then
If VBA.CInt(xObj.Caption) = VBA.CInt(VBA.Day(VBA.Date)) Then
With xObj
.ForeColor = RGB(222, 25, 25)
.BackColor = RGB(255, 255, 255)
Set HotObj = xObj
Set ActObj = xObj
End With
End If
End If
End If
Next xObj
Set xObj = Nothing
End Sub
Public Sub setNowDate()
Dim mobj As Object, m As Integer, mName As String
Set mobj = UserForm1.Label1
m = VBA.CInt(VBA.Replace(mobj.Caption, "月", ""))
mName = VBA.MonthName(m, False)
Dim xDate As Date
Dim d As Integer, dName As String
d = VBA.CInt(HotObj.Caption)
xDate = VBA.DateSerial(VBA.Year(VBA.Date), m, d)
dName = VBA.WeekdayName(VBA.Weekday(xDate), False, vbSunday)
Dim MonthObj As Object
Set MonthObj = UserForm1.Label8
MonthObj.Caption = dName & VBA.Space(2) & mName & VBA.Day(xDate) & "日"
MonthObj.Caption = MonthObj.Caption & VBA.Space(2) & UserForm1.Label2.Caption & "年"
Set mobj = Nothing
Set MonthObj = Nothing
End Sub
代码包括窗体、模块和类模块一共400行左右,整体来说不是很难,但是如果是初学者,一定是没有头绪的,因为其中包含了许多必要的编程方法和技巧,也需要对日期类型的处理函数有一个全面的认识。
END
,