[已解决]日期控件显示问题

xyc680321

在表格的B3单元格设置了日期控件DTP输入日期，设置了只能点击B3单元格日期控件才能被激活，点击其它单元格日期控件不显示，但是遇到有合并单元格时却无法实现这个功能，也就是说当点击到合并单元格时，日期控件仍然被激活，日期会错误的填入合并单元格，有没有办法解决？附件中红色区域为合并单元格

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2014-2-16 13:00

xyc680321 发表于 2014-2-16 12:01
按这样修改，所有的单元格都能激活日期控件了

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     If Target.Count = 1 Then
   
3.         Application.EnableEvents = False
   
4.         If Target.Column = 2 And Target.Row > 2 And Target.Row < 4 Then
   
5.             With Me.DTPicker1
   
6.                 .Visible = True
   
7.                 '调整DTP控件的位置，使其显示在当前单元格之中
   
8.                 .Top = Target.Top
   
9.                 .Left = Target.Left
   
10.                 If Target <> "" Then
    
11.                     '如果当前单元格已有内容，则设置DTP控件初始值为当前单元格日期，否则为系统当前日期
    
12.                     .Value = Target.Value
    
13.                 Else
    
14.                     .Value = Date
    
15.                 End If
    
16.             End With
    
17.         Else
    
18.             Me.DTPicker1.Visible = False
    
19.         End If
    
20. 
    
21.     Else
    
22.         Me.DTPicker1.Visible = False
    
23.     End If
    
24.     Application.EnableEvents = True
    
25. End Sub

复制代码

跳转到最佳答案楼层

xyc680321

这是实现这个功能的vba代码，请看看怎样修改？

Private Sub DTPicker1_CloseUp()
'禁用事件，在将DTP控件的值更新到单元格时，防止Worksheet_Change被误激活
    Application.EnableEvents = False
    ActiveCell.Value = Me.DTPicker1.Value
    Me.DTPicker1.Visible = False
    '启用事件
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'判断是否只选中了单个单元格
    If Target.Column <> 2 And Target.Row <> 3 Then

            Me.DTPicker1.Visible = False
        
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count = 1 Then
    Application.EnableEvents = False
        If Target.Column = 2 And Target.Row > 2 And Target.Row < 4 Then
            With Me.DTPicker1
                .Visible = True
                '调整DTP控件的位置，使其显示在当前单元格之中
                .Top = Target.Top
                .Left = Target.Left
                If Target <> "" Then
                    '如果当前单元格已有内容，则设置DTP控件初始值为当前单元格日期，否则为系统当前日期
                    .Value = Target.Value
                Else
                    .Value = Date
                End If
            End With
        Else
            Me.DTPicker1.Visible = False
        End If
        Application.EnableEvents = True
    End If
End Sub

hwc2ycy

If Target.Column = 2 And Target.Row > 2 And Target.Row < 4 Then
这里限制了只能是A3单元格

xyc680321

这是B3单元格啊，你将我的附件下载看看，谢谢

xyc680321

hwc2ycy 发表于 2014-2-16 11:34
If Target.Column = 2 And Target.Row > 2 And Target.Row < 4 Then
这里限制了只能是A3单元格

If Target.Column = 2 And Target.Row > 2 And Target.Row < 4 Then
这句应该是限制在B3单元格啊

hwc2ycy

xyc680321 发表于 2014-2-16 11:37
If Target.Column = 2 And Target.Row > 2 And Target.Row < 4 Then
这句应该是限制在B3单元格啊

写错了，你都知道是B3了，就把这个限制取消吧。

hwc2ycy

合并单元格你可以看下他的count属性，因为刚开始有个target.count=1的判断，直接给忽略了合并单元格。

hwc2ycy

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     Application.EnableEvents = False
   
3.     With Me.DTPicker1
   
4.         .Visible = True
   
5.         '调整DTP控件的位置，使其显示在当前单元格之中
   
6.         .Top = Target.Top
   
7.         .Left = Target.Left
   
8.         If Target(1) <> "" Then
   
9.             '如果当前单元格已有内容，则设置DTP控件初始值为当前单元格日期，否则为系统当前日期
   
10.             .Value = Target(1).Value
    
11.         Else
    
12.             .Value = Date
    
13.         End If
    
14.     End With
    
15.     Application.EnableEvents = True
    
16. End Sub

复制代码

不管选多少个，只针对左上角的单元格操作。

xyc680321

我的目的就是要限制在B3内输入日期，如果选择其他单元格则日期控件隐藏

xyc680321

hwc2ycy 发表于 2014-2-16 11:55
不管选多少个，只针对左上角的单元格操作。

按这样修改，所有的单元格都能激活日期控件了