Question

如何用vba实现在EXCEL固定区域坐标内点击单元格，显示日期控件？

Answer 1

试验通过测试。
以在E列显示日期时间选择控件为例：
首先从工具箱选择日期时间选择控件，并在工作表中绘制一个控件实例：DTPicker1
在工作表代码页写入如下代码
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Set rag = Application.Intersect(Target, Range("E:E"))
If rag Is Nothing Or rag.Address <> Target.Address Then
'这里的判断显得有些蹩脚，应该有更好办法，希望高手补充！
Else
With DTPicker1
.Top = Target.Cells(1).Top
.Left = Target.Cells(1).Left
.Width = Target.Cells(1).Width
.Height = Target.Cells(1).Height
'设置控件与所选单元格关联：
.LinkedCell = Target.Cells(1).Address
.Visible = True
End With
End If
End Sub

修正代码：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Set rag = Application.Intersect(Target, Range("E:E"))
'主要是这句有所区别
If (Not rag Is Nothing) Then
If Target.Address = rag.Address Then
With DTPicker1
.Visible = True
.Top = Target.Cells(1).Top
.Left = Target.Cells(1).Left
.Width = Target.Cells(1).Width
.Height = Target.Cells(1).Height
.LinkedCell = Target.Cells(1).Address
.Visible = True
End With
End If
Else
DTPicker1.Visible = False
End If
End Sub以上两种方法都可以实现在E列显示空间，在其它列不显示控件。

❤❤❤请高手回复的问题：
当代码改为如下所示时在所有的单元格都显示控件，这是为什么呢！！
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Set rag = Application.Intersect(Target, Range("E:E"))
'仅这句不同
If (Not rag Is Nothing) And Target.Address = rag.Address Then
With DTPicker1
.Top = Target.Cells(1).Top
.Left = Target.Cells(1).Left
.Width = Target.Cells(1).Width
.Height = Target.Cells(1).Height
.LinkedCell = Target.Cells(1).Address
.Visible = True
End With
End If
End Sub

Answer 2

使用单元格被选择事件
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
具体问题具体处理，HI我

Answer 3

Excel 2007 直接做一个按钮 就行了

追问

怎么实现，把代码给出来啊

追答

你是想 点一下 就出现日期吗？

追问

是在指定的区域内，点击单元格就出现日期控件，
例如在C10:E15区域内；

Answer 4

使用VBA， 增加一个form （表单），然后在菜单中选择，tool （工具）-〉Additional Control （附加控件），选择 Calander Control (日期控件） ,然后拖到form 上，调整好大小。 表单命名为userform1 ， 日期控件的名为 Calendar1

在sheet1 中加入以下代码 ( 假设你要在sheet1的"A1" 中设定位启动日起菜单的单元格）：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If TypeName(Selection) <> "Range" Then Exit Sub
If Selection.Address = "$A$1" Then
UserForm1.Show
End If
End Sub

在userform1 的代码中加入以下代码：

Private Sub Calendar1_Click()
Range("A1").Value = Calendar1.Value
Unload UserForm1

End Sub

Answer 5

For i = 1 To 100
Sheets("sheet" & i).Activate
Range("A1:F1").Copy Sheets("汇总").Range("A" & i)
Next i
End Sub