对使用的Microsoft Forms 2.0 object Liebrary控件，在VB中也有这个控件，但就是在做不成呢

晚上花了一点时间，仿写了一下，忘了了它的样子，就自己想当然排列，然后写了一个。样子与楼主提供的不一样。

调用就是一句：

Call Form2.设置日期(Text1.Text, Text1, Me)

参数说明：第一个是设置初始日期，第二个控件，是用来接收返回结果的，第三个是调用的窗体，用来计算日历窗体位置的

这是日历窗体代码

Option Explicit

Const 颜色1 = 8421504       '灰色，用于非本月日期
Const 颜色2 = 16711680      '蓝色，用于本月日期
Const 颜色3 = 8421631       '红色，用于本日
Const 颜色4 = -2147483633   '系统颜色，窗体背景

Dim pubolddate As Date     '保存进入的日期
Dim pubdate As Date     '保存日期
Dim Cancel As Boolean       '是否取消了

Dim dateobj As Object   '保存需要结果的那个控件
Dim datefrm As Form     '保存调用本窗口的窗体

Dim mov As Long      '上次的控件编号
Dim dd(42) As Date

Private Sub Command1_Click()
    pubdate = DateAdd("yyyy", -1, pubdate)      '减少一年
    Call 排列日期
End Sub

Private Sub Command2_Click()
    pubdate = DateAdd("yyyy", 1, pubdate)       '增加一年
    Call 排列日期
End Sub

Private Sub Command3_Click()
    pubdate = DateAdd("m", -1, pubdate)         '减少一月
    Call 排列日期
End Sub

Private Sub Command4_Click()
    pubdate = DateAdd("m", 1, pubdate)          '增加一月
    Call 排列日期
End Sub

Private Sub Command5_Click()
    Cancel = True           '取消
    Unload Me
End Sub

Private Sub ds_Click(Index As Integer)
    pubdate = dd(Index)
    Unload Me       '关掉本窗体，自动返回结果
End Sub

Private Sub Form_GotFocus()
    '
    MsgBox 1

End Sub

Private Sub Form_Load()

Combo1.AddItem "一月"
Combo1.AddItem "二月"
Combo1.AddItem "三月"
Combo1.AddItem "四月"
Combo1.AddItem "五月"
Combo1.AddItem "六月"
Combo1.AddItem "七月"
Combo1.AddItem "八月"
Combo1.AddItem "九月"
Combo1.AddItem "十月"
Combo1.AddItem "十一月"
Combo1.AddItem "十二月"

Call 排列日期

End Sub


Private Sub ds_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

If mov <> Index Then
    If mov > -1 Then            '此处要增加取消，是为了防止鼠标移动过快时，捕捉窗体移动无法取消
        ds(mov).Appearance = 0              '取消沉下去的效果
        ds(mov).BorderStyle = 0
        ds(mov).BackColor = 颜色4     '恢复背景色
        
        If Month(dd(mov)) <> Month(pubdate) Then        '设置颜色，根据月份变颜色
            ds(mov).ForeColor = 颜色1
        Else
            ds(mov).ForeColor = 颜色2
        End If
        
        If dd(mov) = pubolddate And mov < 42 Then       '如果是当前日期   ,42是今天日期，不能显红
            ds(mov).BackColor = 颜色3
        End If
        
    End If
    
    
    ds(Index).Appearance = 1
    ds(Index).BorderStyle = 1

    If Month(dd(Index)) <> Month(pubdate) Then        '设置颜色，根据月份变颜色
        ds(Index).ForeColor = 颜色1
    Else
        ds(Index).ForeColor = 颜色2
    End If
    
        If dd(Index) = pubolddate And Index < 42 Then     '如果是当前日期   ,42是今天日期，不能显红
            ds(Index).BackColor = 颜色3
        End If
    
    
    mov = Index     '设置下一次要弹起来的控件的索引号
End If



End Sub


Private Sub 排列日期()

Dim i As Long   '共多少天
Dim j As Date   '本月第一天
Dim k As Long   '循环变量
Dim o As Long   '本月第一天的单元格编号

Dim ne As Long      '年
Dim ye As Long      '月

If pubdate = "00:00:00" Then        '如果没有调用日期进行使用，就用今天的日期
    pubdate = Date
    pubolddate = pubdate
End If

ne = Year(pubdate)      '取年
ye = Month(pubdate)     '取月

j = CDate(ne & "-" & ye & "-1")     '本月第一天
o = Format(j, "w", vbSunday) - 1        '得到本月第一天的单元格编号


'得到本月最后一天的日期
    i = Day(DateAdd("m", 1, j) - 1)     '本月最后一天
    
    For k = 0 To o - 1
        dd(k) = j - o                   '设置标签对应的日期
        ds(k).Caption = Day(dd(k))      '设置标签名字
        ds(k).ForeColor = 颜色1         '设置字体颜色
        If dd(k) = pubolddate Then       '如果是当前日期
            ds(k).BackColor = 颜色3
        Else
            ds(k).BackColor = 颜色4
        End If
    Next k
    For k = o To o + i - 1
        ds(k).Caption = k - o + 1
        dd(k) = j + k - o
        ds(k).ForeColor = 颜色2
        If dd(k) = pubolddate Then       '如果是当前日期
            ds(k).BackColor = 颜色3
        Else
            ds(k).BackColor = 颜色4
        End If
    Next k
    For k = o + i To 41
        dd(k) = j + k - o
        ds(k).Caption = k - o - i + 1
        ds(k).ForeColor = 颜色1
        If dd(k) = pubolddate Then       '如果是当前日期
            ds(k).BackColor = 颜色3
        Else
            ds(k).BackColor = 颜色4
        End If
    Next k

    ds(42).Caption = "今天是：" & Date      '设置今天
    dd(42) = Date
    
    If Month(dd(42)) <> Month(pubdate) Then        '设置字体颜色
        ds(42).ForeColor = 颜色1
    Else
        ds(42).ForeColor = 颜色2
    End If
    
    
Label1.Caption = ne             '显示年
Combo1.ListIndex = ye - 1       '显示月

'If Me.Visible And Command5.Visible Then
'    Command5.SetFocus               '焦点还是移到关闭按钮上面
'End If

End Sub


Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If mov > -1 Then
    ds(mov).Appearance = 0              '取消沉下去的效果
    ds(mov).BorderStyle = 0
    ds(mov).BackColor = -2147483633     '恢复背景色
    
    If Month(dd(mov)) <> Month(pubdate) Then        '设置字体颜色
        ds(mov).ForeColor = 颜色1
    Else
        ds(mov).ForeColor = 颜色2
    End If
    
    If dd(mov) = pubolddate And mov < 42 Then       '如果是当前日期   ,42是今天日期，不能显红
        ds(mov).BackColor = 颜色3
    End If
    
    mov = -1
End If
End Sub

Public Sub 设置日期(日期 As Date, 返回结果 As Object, 窗体 As Form, Optional 坐标X As Long, Optional 坐标Y As Long)
    pubdate = 日期
    pubolddate = pubdate
    Call 排列日期
    Set dateobj = 返回结果
    Set datefrm = 窗体
    
    '确定日历窗体显示的位置
    
    Dim i As Long
    i = 窗体.Height - 窗体.ScaleHeight      '取得标题的高度
    
    Me.Left = 窗体.Left + 返回结果.Left
    Me.Top = 窗体.Top + 返回结果.Top + i + 返回结果.Height
    
    Me.Show vbModal         '使用有模式的方式显示窗体，所以必须提示一个关闭按纽

End Sub

Private Sub Form_Unload(Cancel As Integer)

If Cancel Then      '如果是取消，那么还原数据
    pubdate = pubolddate
End If

If TypeName(dateobj) = "TextBox" Then       '如果对应是 text ，则使用 text 属性
    dateobj.Text = pubdate
ElseIf TypeName(dateobj) = "Label" Then     '如果对象是 label ，则使用 caption 属性
    dateobj.Caption = pubdate
End If

End Sub

因为是打算给新手看的，所以大量的写了注释。
如果还有不懂的，自己查MSDN或百度一下。
下面是函数 dateadd 的说明

DateAdd 函数
      

返回包含一个日期的 Variant (Date)，这一日期还加上了一段时间间隔。

语法

DateAdd(interval, number, date)

DateAdd 函数语法中有下列命名参数：

部分 描述 
interval 必要。字符串表达式，是所要加上去的时间间隔。 
number 必要。数值表达式，是要加上的时间间隔的数目。其数值可以为正数（得到未来的日期），也可以为负数（得到过去的日期）。 
date 必要。Variant (Date) 或表示日期的文字，这一日期还加上了时间间隔。 


设置

interval 参数具有以下设定值：

设置 描述 
yyyy 年 
q 季 
m 月 
y 一年的日数 
d 日 
w 一周的日数 
ww 周 
h 时 
n 分钟 
s 秒 


说明

可以使用 DateAdd 函数对日期加上或减去指定的时间间隔。例如，可以用 DateAdd 来计算距今天为三十天的日期；或者计算距现在为 45 分钟的时间。

为了对 date 加上“日”，可以使用“一年的日数” (“y”)，“日” (”d”) 或“一周的日数” (”w”)。

DateAdd 函数将不返回有效日期。在以下实例中将 1 月31 日加上一个月：

DateAdd(m, 1, 31-Jan-95)

上例中，DateAdd 返回 1995 年 2 月 28 日，而不是 1995 年 2 月 31 日。如果 date 是 1996 年 1 月 31 日，则由于 1996 年是闰年，返回值是 1996 年 2 月 29 日。

如果计算的日期超前 100 年（减去的年度超过 date 中的年份），就会导致错误发生。

如果 number 不是一个 Long 值，则在计算时取最接近的整数值来计算。

注意   DateAdd 返回值的格式由 Control Panel设置决定，而不是由传递到date 参数的格式决定。

刚回来翻贴 子，发现一个BUG。
定义变量 Cancel  不能用这个名字。
自己随便 改一下名字吧，反正不能用这个名字，与模块里的自动变量名冲突。

呵呵风吹过老师，厉害强悍，一个晚上就搞定了，真的明白什么叫专业了，谢谢你哦

做的这么快呢，我什么时侯能学到这样呢唉

版主的代码学习了，有个问题就是上月的灰色日期，计算不对，怎么修改代码呢，谢谢

请教老师那句代码有问题呢

你计算出了第一个格子是那一天，那么第二个格子，等于前面一个格子 加1 啊。
不要直接复制前面那个格子的内容。