单元格中引用日历

[转帖]Excel-单击单元格弹出活动日历2009-12-29 20:26题记：老同学“芝麻汤圆”发来一个文件，要实现活动日历效果。

研究了下文件里的VBA代码，搞定！嘿嘿方法：1、右键单击工具栏，选中Visual Basic;2、单击工具栏上的“控件工具箱”（小榔头形状）；3、单击控件工具箱工具栏上的“其他控件”（小榔头形状）；4、找到 "Microsoft Date And Time Piker Control 6.0 (SP4)"，选中它；5、在你所要用到的单元格内画出，大小要和单元格一样；6、选中控件，右键单击选择菜单“设置控件格式”，在"属性"选项中选择“大小固定、位置随单元格而变”，确定；7、右键单击控件选择菜单“查看代码”，进入VBA后，将里面的代码替换为：8、（使用代码一，需要进行此项目设置）返回到Excel,调整单元格大小使控件完全显示；9、退出设计模式，OK。

要实现你的要求分三个步骤：1、在工作表中插入一个日历控件如：microsoft date and time picker2、在控件的lost focus 事件中加入以下的代码：cells(5,5)=dtpicker1.value (日历控件的名称为：dtpicker1)，每当用户选择了日历控件时，当他退出后，自动让指定的单元格内容update3、在workbook的before save事件中加入以下的内容 If IsNull(Cells(5, 5).Value) Or Cells(5, 5) = "" Then MsgBox "请先选择日期" Cancel = True End If 如果没有选择日期(单元格为空时)提醒用户没有选择日历，不让保存文件。

èdìshényǎ[大师]插入--》对象--》新建--》日历控件11.0这样可以在Excel中插入一个日历，很方便。

如果需要获取这个日历上的点击值，可以通过简单的VBA代码实现Alt+F11,进入VBE，双击左侧“Sheet1”，复制以下代码进去即可，如果要将日历中点击值传到其他位置，修改“Sheets("sheet1"). Range("F3") ”中的“sheet1”及“F3”即可。

Option ExplicitPrivate Sub Calendar1_Click()Sheets("sheet1").Range("F3") = Calendar1.ValueEnd Sub如附件所示：附件：日历.xls选择日期Excel日历控件将日期插入到指定单元格实例(2010-09-13 10:44:09)转载▼分类：VBA标签：杂谈指定的单元格？请跟随如下操作；在EXCEL窗口中执行“视图”→“工具栏”→“控件工具箱”；弹出如下图对话框；按上图的操作，找到“日历控件11.0”，之后在EXCEL窗口中使用鼠标左键一拖，拖出如下图的控件；上图，我们要实现的结果是：在C列中，无论点击哪个单元格，就弹出日历控件，选择一个日期之后，日期自动插入到单元格；除C列之外，点击其他列的单元格，不会弹出日历选择控件；要想实现这样的效果，得使用VBA来实现；选择日历控件，鼠标左键双击，进入代码编辑模式；如下图！上图中，第一个过程代码就是日历控件所需要的代码，另外，还得需要另外一个代码，在图中按红线圈住部分选择，找到对应的过程，输入如下的VBA代码即可！完成之后，直接运行VBA代码，返回EXCEL操作窗口，即可实现效果了！如上图，C3单元格已插入了日期，当你选择C列其他单元格时，就弹出日历控件，以供选择，选择完成，即可插入日期了！为方便操作，提供源代码：Private Sub Calendar1_Click()ActiveCell = Calendar1.ValueMe.Calendar1.Visible = FalseEnd SubPrivate Sub Worksheet_SelectionChange(ByVal Target As Range)If Target.Column = 1 ThenMe.Calendar1.Visible = TrueElseMe.Calendar1.Visible = FalseEnd IfEnd Sub知识扩展：①执行上述代码时，可能会遇到创建宏的提示，随便输入宏名，再运行即可！②可以将上述的代码及EXCEL文件一起保持，以备不时之需，以后你再需要到这种功能，直接打开EXCEL文件即可！打开EXCEL文件，运行原来的宏，有可能出现“宏”被禁止运行的提示，解决的方法如下：在EXCEL操作中执行“工具”→“宏”→“安全性”；弹出如下的对话框；上图中，选择“安全级”选项卡，将安全设置为“中”即可！之后关闭EXCEL，再打开，就能运行了！单元格中日历制作Private Sub DTPicker1_Change()Selection.Value = DTPicker1.ValueIf [a1] >= [B1] Then[a1] = ""ElseEnd IfDTPicker1.Visible = FalseEnd SubPrivate Sub Worksheet_Activate()DTPicker1.Value = DateEnd SubPrivate Sub Worksheet_SelectionChange(ByVal Target As Range)If Target.Address = "$A$1" Or Target.Address = "$B$1" ThenWith DTPicker1.Visible = True.Value = Date.Height = Target.Height.Width = Target.Width.Top = Target.Top.Left = Target.LeftEnd WithElseDTPicker1.Visible = FalseEnd IfEnd SubPrivate Sub DTPicker1_Change()Selection.Value = DTPicker1.ValueIf [a1] >= [b1] Then[a1] = ""[c1] = ""Else[c1] = [b1] - [a1]End IfDTPicker1.Visible = FalseEnd Sub我给做个注解，不对和不会的请老师指正，谢谢！Private Sub DTPicker1_Change() ’这是不是下定义的语句，DTPicker1（控件名字？）发生变化的时候进行下面的语句。

Selection.Value = DTPicker1.Value '给激活的单元格赋予控件值。

If [a1] >= [B1] Then 'if语句。

[a1] = "" '这句为什么要赋予空值？是不是也可以赋予字符串？能不能弹出自定的提示窗口？Else ‘反之。

End If 'if语句结束。

DTPicker1.Visible = False ‘不显示控件。

End Sub ‘动作结束。

Private Sub Worksheet_Activate() ‘Worksheet是什么？DTPicker1.Value = Date ’是赋予当日时间吗?End Sub '这个动作我不知道有什么用？Private Sub Worksheet_SelectionChange(ByVal Target As Range) ‘这个是定义什么？不明白，请解释一下，谢谢！括号内是参数？If Target.Address = "$A$1" Or Target.Address = "$B$1" Then ‘如果选中A1或B1With DTPicker1 '定义日历控件属性？.Visible = True.Value = Date ‘前面不是已经赋值当日日期起了吗？为什么还？.Height = Target.Height.Width = Target.Width.Top = Target.Top.Left = Target.LeftEnd WithElseDTPicker1.Visible = False '反之不显示End IfEnd SubPrivate Sub Workshee t_Activate() ‘Worksheet是什么？DTPicker1.Value = Date ’是赋予当日时间吗?End Sub '这个动作我不知道有什么用？是你文件中原有的,可不要.Private Sub DTPicker1_Change() ‘这个应该是C1求日期差的，可是怎么又和DTPicker1有关系了？难道是控件值变化，就从新赋值一下吗？我现在么有excel软件，不能实践。

Selection.Value = DTPicker1.Value ‘需要激活C1才能赋值吗？能不能A1、B1确定了日期，C1自动得出赋值。

If [a1] >= [b1] Then ‘判断日期前后。

[a1] = ""[c1] = ""Else[c1] = [b1] - [a1]End IfDTPicker1.Visible = False ‘这句是不是也可以没有，因为前面已经有隐藏语句了。

End SubPrivate Sub Worksheet_SelectionChange(ByVal Target As Range) ‘单元格选择事件If Target.Address = "$A$1" Or Target.Address = "$B$1" Then ‘如果选中A1或B1 With DTPicker1 '定义日历控件属性？.Visible = True'显示.Value = Date ‘赋值当日日期.Height = Target.Height '日历控件高度.Width = Target.Width '宽度.Top = Target.Top '上边距.Left = Target.Left ''左边距End WithElseDTPicker1.Visible = False '反之不显示,,,,,,,,,,,,,,,,,,,,,,,,,,另有,当控件弹出你没选择控件操作时,点击其它单元格,控件隐藏.End IfEnd SubPrivate Sub DTPicker1_Change() ‘C1求日期差的,在DTPicker1选择中就同时完成Selection.Valu e = DTPicker1.Value ‘就是A1、B1确定了日期，C1自动得出赋值。