自己做的日历窗体，拿出来分享一下

祁笑

原来用的2003版的还有自带的日历控件，后来升级后就没了，很是不方便，于是自己做了一个，为了用起来方便，特意把窗体名称改为userform1000，这样在导入窗体时就不会重名了。主要知识点用到了类模块。

下面是userform1000中的代码：

Dim col As New Collection
Private Sub ComboBox2_Change()
Dim n As Integer
For n = 28 To 31
If Me.Controls("commandbutton" & n).Visible = False Then
Me.Controls("commandbutton" & n).Visible = True
End If
Next
If VBA.Len(ComboBox2.Value)  0 And VBA.Len(ComboBox1.Value)  0 Then
n = VBA.Day(DateSerial(ComboBox1.Value, ComboBox2.Value + 1, 0)) '取当月的天数
If n = 28 Then
CommandButton29.Visible = False
CommandButton30.Visible = False
CommandButton31.Visible = False

End If
If n = 29 Then
CommandButton30.Visible = False
CommandButton31.Visible = False
End If
If n = 30 Then
CommandButton31.Visible = False
End If
End If
End Sub

Private Sub CommandButton32_Click()
TextBox1.Value = ""
End Sub

Private Sub CommandButton33_Click()
TextBox2.Value = ""
End Sub

Private Sub CommandButton34_Click()
If Not IsDate(TextBox1.Value) Or Not IsDate(TextBox2.Value) Then
        MsgBox "请输入有效的日期（例如：2025-1-1）", vbExclamation
        Exit Sub
    End If
If CDate(TextBox2.Value) - CDate(TextBox1.Value) < 0 Then
MsgBox &quot;终止日期不能小于起始日期&quot;
Exit Sub
End If
If VBA.Len(TextBox1.Value) = 0 Or VBA.Len(TextBox2.Value) = 0 Then
MsgBox &quot;起始日期或终止日期不能为空&quot;
Exit Sub
End If
Sheet1.Range(&quot;b1&quot;).Value = TextBox1.Value
Sheet1.Range(&quot;b2&quot;).Value = TextBox2.Value
Unload Me
End Sub

Private Sub UserForm_Initialize()
Dim i As Integer, n As Integer, m As Integer
Dim myc As cmds

i = VBA.Year(VBA.Date)
For n = i - 2 To i + 5
ComboBox1.AddItem n
Next
For m = 1 To 12
ComboBox2.AddItem m
Next
ComboBox1.Value = VBA.Year(VBA.Date)
ComboBox2.Value = VBA.Month(VBA.Date)
For i = 1 To 31
Set myc = New cmds
Set myc.cmd = Me.Controls(&quot;commandbutton&quot; & i)
col.Add myc
Next
Set myc = Nothing
End Sub

Private Sub ComboBox1_Change()

If VBA.Len(ComboBox1.Value)  0 And ComboBox1.Value Mod 4 = 0 And ComboBox2.Value = 2 Then
  If CommandButton29.Visible = False Then
CommandButton29.Visible = True
End If
End If
If VBA.Len(ComboBox1.Value)  0 And ComboBox1.Value Mod 4  0 And ComboBox2.Value = 2 Then
  If CommandButton29.Visible = True Then
CommandButton29.Visible = False
End If
End If
End Sub

下面是类模块代码：

Public WithEvents cmd As MSForms.CommandButton
Public riqi As String

Private Sub cmd_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If VBA.Len(UserForm1000.TextBox1.Value) > 0 And VBA.Len(UserForm1000.TextBox2.Value) > 0 Then
MsgBox &quot;起始日期和终止日期均已填写，如需更改，请点击“起始日期”或“终止日期”按钮。&quot;
Exit Sub
End If

If VBA.Len(UserForm1000.ComboBox1.Value)  0 And VBA.Len(UserForm1000.ComboBox2.Value)  0 Then
riqi = UserForm1000.ComboBox1.Value & &quot;/&quot; & UserForm1000.ComboBox2.Value & &quot;/&quot; & cmd.Caption
If VBA.Len(UserForm1000.TextBox1.Value) = 0 Then
UserForm1000.TextBox1.Value = riqi
GoTo 100
End If
If VBA.Len(UserForm1000.TextBox2.Value) = 0 And VBA.Len(UserForm1000.TextBox1.Value) > 0 Then
UserForm1000.TextBox2.Value = riqi
End If
End If
100:
End Sub

使用方法：
1、导出本文件的userform1000窗体到目标文件中
2、复制本文件中的类模块内容，在目标文件中创建类模块，并把类一名称改为cmds
3、修改类模块中的cmds中的代码，或者userform1000中的代码即可

我的日历.zip (28 KB, 下载次数: 0)

2026-4-28 17:50 上传

点击文件名下载附件

神鰰神

感谢楼主无私分享

笨爸说

下了，感谢楼主的分享，不太会使用，请问一下能动态显示日期吗。谢谢！

夏日清荷

分享一个日历窗口
https://club.excelhome.net/thread-1687585-1-1.html
(出处: ExcelHome技术论坛)

唐广宁

感谢分享！！！

枫落雪飘

感谢楼主分享！

奶粉牛

碰巧看到了自己之前的帖子，后来我又做了个日历，不是用的类模块，就是用的普通的方法，反思一下，其实我们利用日历工具的目的，就是1、保证日期的格式正确，2、输入速度快捷，3、2月份28天或29天以及其他月份30天或31天的问题。要快捷还是用面板的形式最好了，尽量把月份和日期都摆在用户面前，尽量少用combobox下拉列表，下拉选择会拖慢速度。我用选项按钮OptionButton，并把月份和日期分别放在两个Frame中，这样就能保证单一选择的问题。

考虑到多场景应用，例如输入起止日期，设置了“单一日期”和“起止日期”的设置按钮，当为起止日期时，会选择两次日期，并保存到相应位置。至于将日期放置在什么地方，是否可以自定义，在窗体中，我是把日期放置在selection中了，而截止日期则放置在selection.offset(0,2)，那么在调用userform时，则可以先select,例如：
Public Sub shurudate()
sheet1.range(&quot;b1&quot;).select'先进行单元格选中，那么窗体中的selection就知道是什么位置了
UserForm400.Show
End Sub
对于28天29天30天31天的问题，我是对每个月份的click()事件进行了赋码，看似比较繁琐，但就是复制粘贴代码，也不麻烦。
Private Sub OptionButton1_Click()
'如果1月被选择
If VBA.Len(ComboBox1.Value) = 0 Then
MsgBox &quot;没有选择年份&quot;
Exit Sub
End If
Me.Controls(&quot;OptionButton41&quot;).Visible = True
Me.Controls(&quot;OptionButton42&quot;).Visible = True
Me.Controls(&quot;OptionButton43&quot;).Visible = True
End Sub

Private Sub OptionButton10_Click()
'如果10月被选择
If VBA.Len(ComboBox1.Value) = 0 Then
MsgBox &quot;没有选择年份&quot;
Exit Sub
End If
Me.Controls(&quot;OptionButton41&quot;).Visible = True
Me.Controls(&quot;OptionButton42&quot;).Visible = True
Me.Controls(&quot;OptionButton43&quot;).Visible = True
End Sub

Private Sub OptionButton11_Click()
'如果11月被选择
If VBA.Len(ComboBox1.Value) = 0 Then
MsgBox &quot;没有选择年份&quot;
Exit Sub
End If
Me.Controls(&quot;OptionButton41&quot;).Visible = True
Me.Controls(&quot;OptionButton42&quot;).Visible = True
Me.Controls(&quot;OptionButton43&quot;).Visible = False
End Sub

Private Sub OptionButton12_Click()
'如果12月被选择
If VBA.Len(ComboBox1.Value) = 0 Then
MsgBox &quot;没有选择年份&quot;
Exit Sub
End If
Me.Controls(&quot;OptionButton41&quot;).Visible = True
Me.Controls(&quot;OptionButton42&quot;).Visible = True
Me.Controls(&quot;OptionButton43&quot;).Visible = True
End Sub

Private Sub OptionButton2_Click()
'如果2月被选择
If VBA.Len(ComboBox1.Value) = 0 Then
MsgBox &quot;没有选择年份&quot;
Exit Sub
End If
If ComboBox1.Value Mod 4 = 0 Then
Me.Controls(&quot;OptionButton42&quot;).Visible = False
Me.Controls(&quot;OptionButton43&quot;).Visible = False
Else
Me.Controls(&quot;OptionButton41&quot;).Visible = False
Me.Controls(&quot;OptionButton42&quot;).Visible = False
Me.Controls(&quot;OptionButton43&quot;).Visible = False
End If
End Sub

Private Sub OptionButton3_Click()
'如果3月被选择
If VBA.Len(ComboBox1.Value) = 0 Then
MsgBox &quot;没有选择年份&quot;
Exit Sub
End If
Me.Controls(&quot;OptionButton41&quot;).Visible = True
Me.Controls(&quot;OptionButton42&quot;).Visible = True
Me.Controls(&quot;OptionButton43&quot;).Visible = True
End Sub

Private Sub OptionButton4_Click()
'如果4月被选择
If VBA.Len(ComboBox1.Value) = 0 Then
MsgBox &quot;没有选择年份&quot;
Exit Sub
End If
Me.Controls(&quot;OptionButton41&quot;).Visible = True
Me.Controls(&quot;OptionButton42&quot;).Visible = True
Me.Controls(&quot;OptionButton43&quot;).Visible = False
End Sub

Private Sub OptionButton5_Click()
'如果5月被选择
If VBA.Len(ComboBox1.Value) = 0 Then
MsgBox &quot;没有选择年份&quot;
Exit Sub
End If
Me.Controls(&quot;OptionButton41&quot;).Visible = True
Me.Controls(&quot;OptionButton42&quot;).Visible = True
Me.Controls(&quot;OptionButton43&quot;).Visible = True
End Sub

Private Sub OptionButton6_Click()
'如果6月被选择
If VBA.Len(ComboBox1.Value) = 0 Then
MsgBox &quot;没有选择年份&quot;
Exit Sub
End If
Me.Controls(&quot;OptionButton41&quot;).Visible = True
Me.Controls(&quot;OptionButton42&quot;).Visible = True
Me.Controls(&quot;OptionButton43&quot;).Visible = False
End Sub

Private Sub OptionButton7_Click()
'如果7月被选择
If VBA.Len(ComboBox1.Value) = 0 Then
MsgBox &quot;没有选择年份&quot;
Exit Sub
End If
Me.Controls(&quot;OptionButton41&quot;).Visible = True
Me.Controls(&quot;OptionButton42&quot;).Visible = True
Me.Controls(&quot;OptionButton43&quot;).Visible = True
End Sub

Private Sub OptionButton8_Click()
'如果8月被选择
If VBA.Len(ComboBox1.Value) = 0 Then
MsgBox &quot;没有选择年份&quot;
Exit Sub
End If
Me.Controls(&quot;OptionButton41&quot;).Visible = True
Me.Controls(&quot;OptionButton42&quot;).Visible = True
Me.Controls(&quot;OptionButton43&quot;).Visible = True
End Sub

Private Sub OptionButton9_Click()
'如果9月被选择
If VBA.Len(ComboBox1.Value) = 0 Then
MsgBox &quot;没有选择年份&quot;
Exit Sub
End If
Me.Controls(&quot;OptionButton41&quot;).Visible = True
Me.Controls(&quot;OptionButton42&quot;).Visible = True
Me.Controls(&quot;OptionButton43&quot;).Visible = False
End Sub

Private Sub UserForm_Initialize()
Dim n As Long, x As Integer
CommandButton4.Caption = &quot;单一日期&quot;
CommandButton3.Visible = False
CommandButton2.Caption = &quot;OK&quot;

n = VBA.Year(Date)
For x = 1 To 8
ComboBox1.AddItem n - 2 + x
Next
ComboBox1.Value = n
End Sub
我实际用起来确实比较方便，代码不复杂，但是思路还是不错的，不需要花里胡哨的界面，只求效率。 日历文件.rar (325 Bytes, 下载次数: 0)

2026-4-28 17:50 上传

点击文件名下载附件