[已解决]excel在任意两个单元格内插入日历控件

七帝

如题，不是一行，也不是一列，比如A1,B2这种，是日历控件不是DTP控件，VBA程序应该怎么写？

最佳答案

月排行榜 / 总排行榜

冥王

2014-12-15 16:27

代码稍作处理了一下

1. Private Sub Calendar1_Click()
   
2.     ActiveCell.Value = Calendar1.Value
   
3.     Calendar1.Visible = False
   
4. End Sub
   
5. 
   
6. 
   
7. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
8.     If Target.Count = 1 And (Target.Address = "$A$1" Or Target.Address = "$B$1") Then
   
9.         With Calendar1
   
10.             .Visible = True
    
11. '            .Height = 120                      '日历控件的高，注释的4行代码也可以不用加入，采取默认设置也行
    
12. '            .Width = 180                       '日历控件的宽
    
13. '            .Top = Target.Offset(1, 0).Top     '日历控件的上方与当前单元格的下面那个单元格上边线对齐
    
14. '            .Left = Target.Offset(0, 1).Left   '日历控件的左边与当前单元格的右边那个单元格左边线对齐
    
15.             .Value = Target.Value
    
16.         End With
    
17.     Else
    
18.         Calendar1.Visible = False
    
19.         Exit Sub
    
20.     End If
    
21. End Sub

复制代码

跳转到最佳答案楼层

冥王

……

冥王

代码稍作处理了一下

1. Private Sub Calendar1_Click()
   
2.     ActiveCell.Value = Calendar1.Value
   
3.     Calendar1.Visible = False
   
4. End Sub
   
5. 
   
6. 
   
7. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
8.     If Target.Count = 1 And (Target.Address = "$A$1" Or Target.Address = "$B$1") Then
   
9.         With Calendar1
   
10.             .Visible = True
    
11. '            .Height = 120                      '日历控件的高，注释的4行代码也可以不用加入，采取默认设置也行
    
12. '            .Width = 180                       '日历控件的宽
    
13. '            .Top = Target.Offset(1, 0).Top     '日历控件的上方与当前单元格的下面那个单元格上边线对齐
    
14. '            .Left = Target.Offset(0, 1).Left   '日历控件的左边与当前单元格的右边那个单元格左边线对齐
    
15.             .Value = Target.Value
    
16.         End With
    
17.     Else
    
18.         Calendar1.Visible = False
    
19.         Exit Sub
    
20.     End If
    
21. End Sub

复制代码

七帝

冥王 发表于 2014-12-15 16:27
代码稍作处理了一下

非常感谢冥王大大，这个问题已经解决了。能不能再请问一下，合并多个单元格以后怎么插入日历控件，万分感谢

冥王

七帝 发表于 2014-12-15 19:07
非常感谢冥王大大，这个问题已经解决了。能不能再请问一下，合并多个单元格以后怎么插入日历 ...

1. If Target.Count = 1 And (Target.Address = "$A$1" Or Target.Address = "$B$1") Then

复制代码

如果是合并单元格的话,如A1 BA两个单元格合并了，上面那行代码需要修改成：

1. If Target.Address = "$A$1:$B$1" Then

复制代码

七帝

冥王 发表于 2014-12-15 21:31
如果是合并单元格的话,如A1 BA两个单元格合并了，上面那行代码需要修改成：

冥王大大太给力了，能不能再麻烦以下，在两个合并的单元格里插入日历控件怎么改？谢谢

冥王

1. Private Sub Calendar1_Click()
   
2.     ActiveCell.Value = Calendar1.Value
   
3.     Calendar1.Visible = False
   
4. End Sub
   
5. 
   
6. 
   
7. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
8.     If Target.Address = "$A$1:$B$1" Or Target.Address = "$D$1:$E$1" Or Target.Address = "$F$1:$G$1" Then  '多个合并单元格，这里可以一直or，地址作下适当更改，此处A1B1、D1E1、F1G1是三个合并单元格
   
9.         With Calendar1
   
10.             .Visible = True
    
11.             '            .Height = 120                      '日历控件的高，注释的4行代码也可以不用加入，采取默认设置也行
    
12.             '            .Width = 180                       '日历控件的宽
    
13.             '            .Top = Target.Offset(1, 0).Top     '日历控件的上方与当前单元格的下面那个单元格上边线对齐
    
14.             '            .Left = Target.Offset(0, 1).Left   '日历控件的左边与当前单元格的右边那个单元格左边线对齐
    
15.             .Value = Target.Value
    
16.         End With
    
17.     Else
    
18.         Calendar1.Visible = False
    
19.         Exit Sub
    
20.     End If
    
21. End Sub

复制代码

dyzx

冥王 发表于 2014-12-15 16:27
代码稍作处理了一下

冥王老师：为什么任意点一个单元格就出现一个对话框，是什么原因，请指教，多谢。

冥王

dyzx 发表于 2014-12-17 15:01
冥王老师：为什么任意点一个单元格就出现一个对话框，是什么原因，请指教，多谢。

看一下你的Excel 插入控件这里有日历控件吗，版本是11.0还是12.0没关系，没有的话到网上去下载一个，爱疯版主有个帖子，就有提供下载的，可以去看一下
http://www.excelpx.com/thread-255298-1-1.html

dyzx

冥王 发表于 2014-12-17 15:43
看一下你的Excel 插入控件这里有日历控件吗，版本是11.0还是12.0没关系，没有的话到网上去下载一个，爱疯 ...

冥王老师：如果没有怎样操作，我安装的系统是win7  64位操作系统，请指教，多谢