自定义日期选择器弹出 Excel 2010答案

【问题标题】：custom date picker popup excel 2010自定义日期选择器弹出 Excel 2010
【发布时间】：2016-08-15 15:07:07
【问题描述】：

我发现这个惊人的日期选择器来自一个团队，可以在不支持日历控制的 Excel 版本中自定义使用。我将此添加到我的另一个 WB 中，这样每次用户单击需要日期的列时，就会出现 datepicker 用户表单，然后在单元格中输入选定的日期。

现在我正在尝试将它与我创建的用户表单一起使用。我添加了一个文本框，当用户窗体打开时自动填充今天的日期，但我想以某种方式让 datepickerform 在单击日期文本框时弹出。我添加了private sub textbox_change() datepickerform.show，但收到运行时错误91“对象变量或未设置块变量”。

调试器将我带到 DatePickerForm 代码的这一部分，第一行突出显示。

Private Sub UserForm_Activate()

If IsDate(Target.Value) Then
    Calendar1.Value = Target.Value
End If

Call MoveToTarget

End Sub

这是因为我的文本框不是日期格式而被标记的吗？我可以根据要求分享完整的代码，只是它很多，我不想添加到我已经很长的帖子中。

这里是 datepickerform 的代码：

Option Explicit


Private WithEvents Calendar1 As cCalendar

Public Target As Range

Private Sub Calendar1_Click()
    Call CloseDatePicker(True)
End Sub

Private Sub Calendar1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyEscape Then
        Call CloseDatePicker(False)
    End If
End Sub

Private Sub UserForm_Initialize()
    If Calendar1 Is Nothing Then
        Set Calendar1 = New cCalendar
        With Calendar1
            .Add_Calendar_into_Frame Me.Frame1
            .UseDefaultBackColors = False
            .DayLength = 3
            .MonthLength = mlENShort
            .Height = 120
            .Width = 180
            .GridFont.Size = 7
            .DayFont.Size = 7
            .Refresh
        End With
        Me.Height = 153 'Win7 Aero
        Me.Width = 197
    End If
End Sub



Public Sub MoveToTarget()
    Dim dLeft As Double, dTop As Double

    dLeft = Target.Left - ActiveWindow.VisibleRange.Left + ActiveWindow.Left
    If dLeft > Application.Width - Me.Width Then
        dLeft = Application.Width - Me.Width
    End If
    dLeft = dLeft + Application.Left

    dTop = Target.Top - ActiveWindow.VisibleRange.Top + ActiveWindow.Top
    If dTop > Application.Height - Me.Height Then
        dTop = Application.Height - Me.Height
    End If
    dTop = dTop + Application.Top

    Me.Left = IIf(dLeft > 0, dLeft, 0)
    Me.Top = IIf(dTop > 0, dTop, 0)
End Sub


Sub CloseDatePicker(Save As Boolean)
    If Save And Not Target Is Nothing And IsDate(Calendar1.Value) Then
        Target.Value = Calendar1.Value
    End If
    Set Target = Nothing

    Me.Hide
End Sub

【问题讨论】：

日历日期选择器是它自己的对象，必须在您的用户表单中创建。您的用户表单的初始化代码可以创建该日期选择器对象并在您的用户表单上选择日期控件时取消隐藏它。运行时错误正在抱怨，因为您没有在任何地方创建日期选择器对象。如果要在用户表单之外创建日期选择器对象，请创建用户表单的属性以“让”外部日期选择器对象分配给用户表单变量。
玩了一段时间后，当我选择主用户表单的指定文本框时，我会弹出自定义日期选择器表单，但是当我选择日期时，它没有更改文本框的值。我实际上完全取消了上面的用户表单激活，它会正确弹出和关闭，它只是不会更新文本框的值。
如果没有看到日期选择器的代码，或者不了解它，我无法知道日期选择器对象更新的方式/内容，即如何将日期选择器连接到您的文本框（或工作表单元格，或任何东西）。
抱歉，我用日期选择器表单代码更新了我的帖子。我还想我会为使用不支持日历控件的 excel 版本的任何人共享自定义日期选择器的原始源。 sites.google.com/site/e90e50/calendar-control-class#TOC-UPDATES

标签： excel datepicker vba

【解决方案1】：

这比我想象的要简单得多，我想我经常过度考虑代码的复杂性，因为我对 VBA 很陌生，几乎不知道。

我更改了关闭字符串，但尚未遇到任何问题。

Sub CloseDatePicker(Save As Boolean)

 myUserForm.myTextBox.Text = Calendar1.Value

    Me.Hide
End Sub

如果有人对此感兴趣，我想我已经完成了我的最终产品。我在单击按钮时将主用户窗体拉起，并使用此编码将其置于活动的 excel 窗口中（我使用双显示器，并且使用基本设置时用户窗体无法正确显示，它们会在非活动屏幕上弹出）

Sub ShowForm()

With Audit_Criteria
  .StartUpPosition = 0
  .Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
  .Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
  .Show
End With
End Sub

然后当用户在用户窗体上选择“日期”文本框时，日期选择器窗体将弹出，与位于用户窗体右上角的文本框重叠。

Private Sub tbDOS_Enter()
With DatePickerForm
  .StartUpPosition = 0
  .Left = Application.Left + (0.5 * Application.Width) - (0.01 * .Width)
  .Top = Application.Top + (0.5 * Application.Height) - (1.5 * .Height)
  .Show
End With
End Sub

我不确定是否有更简单的方法可以通过识别文本框位置并从中偏移日期选择器来做到这一点，但这是我得出的结果，由于我缺乏经验，不知道另一种方法。

【讨论】：