将 DatePicker 数据粘贴到文本框中

Question

我想在选择 Commandbutton7 时显示日历，然后用所选日期填充 TextBox13。

如何在文本框中输入日期？

Private Sub CommandButton9_Click()
    frm_Cal.Show
    Me.TextBox13.Value = Me.frm_Cal.Value
End Sub

之前，我使用此代码将日期输入到单元格中，该代码运行正常。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.CountLarge > 1 Then Exit Sub
Dim DateRange As Range
Set DateRange = Me.ListObjects("Table1").ListColumns("Date1").DataBodyRange
    If Not Intersect(Target, DateRange) Is Nothing Then
        Cancel = True
        frm_Cal.Show
    End If
End Sub

我试过这个。

Private Sub CommandButton9_Click()

    Dim currentActiveCell As String
    currentActiveCell = ActiveCell.Address

    Range("A1").Select

    frm_Cal.Show

    If Not frm_Cal Is Nothing Then
        TextBox13.Value = ActiveCell.Value
    End If

    Range(currentActiveCell).Select
End Sub

Answer 1

以下是更改表单代码的方法：

Option Explicit
 
Private m_date As String 'stores the date selected (as a string)

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Cancel = True 'if user tries to close the form, just hide it
    Me.Hide
End Sub

'add this property Get method
Public Property Get SelectedDate() As String
    SelectedDate = m_date
End Property

Private Sub ComboBox1_Change()
    CheckAddDates
End Sub

Private Sub ComboBox2_Change()
    CheckAddDates
End Sub

Sub CheckAddDates()
    If Me.ComboBox1.Value <> "" And Me.ComboBox2.Value <> "" Then
        Call Add_Dates
    End If
End Sub

'new sub for handling clicked "day" button
Private Sub DayClicked(btn As CommandButton)
    With btn
        If .Caption <> "" Then
             'Call Reset_Colors
            .BackColor = RGB(214, 191, 249)
            Me.TextBox1.Value = .Caption & "-" & Me.ComboBox1.Value & "-" & Me.ComboBox2.Value
            m_date = Me.TextBox1.Value 'save the date....
            Me.Hide '<<### don't unload here!
        End If
    End With
End Sub

Private Sub CommandButton1_Click()
    DayClicked Me.CommandButton1
End Sub
Private Sub CommandButton2_Click()
    DayClicked Me.CommandButton2
End Sub
Private Sub CommandButton3_Click()
    DayClicked Me.CommandButton3
End Sub
Private Sub CommandButton4_Click()
    DayClicked Me.CommandButton4
End Sub
Private Sub CommandButton5_Click()
    DayClicked Me.CommandButton5
End Sub
Private Sub CommandButton6_Click()
    DayClicked Me.CommandButton6
End Sub
Private Sub CommandButton7_Click()
    DayClicked Me.CommandButton7
End Sub
Private Sub CommandButton8_Click()
    DayClicked Me.CommandButton8
End Sub
Private Sub CommandButton9_Click()
    DayClicked Me.CommandButton9
End Sub
'......
'etc for all "day" CommandButtons
'......

...所以您想要

Hide

表单而不是卸载它 - 将其保留在内存中并将控制权返回给调用代码，以便它可以读取所选日期，然后才卸载它。

常规模块中的示例代码：

Sub Tester()
    Dim dt
    dt = GetUserDate()
    If Len(dt) > 0 Then
        MsgBox "Selected date: " & dt
    Else
        MsgBox "No date selected"
    End If
End Sub

'shows the form and returns any selected date
Function GetUserDate()
    Dim frm As frm_Cal
    Set frm = New frm_Cal
    frm.Show
    GetUserDate = frm.SelectedDate
    Unload frm ' now you can unload...
End Function

对您的

Add_Dates

用户表单方法还有一个建议：

Private Sub Add_Dates()
    Dim firstWeekDay As Long
    Dim first_Date As Date
    Dim last_day As Long, i As Long, d As Long, mon, yr

    mon = Me.ComboBox1.Value
    yr = Me.ComboBox2.Value
    first_Date = DateValue("1-" & mon & "-" & yr)
    firstWeekDay = Weekday(first_Date)
    last_day = Day(Application.WorksheetFunction.EoMonth(first_Date, 0))

    For i = 1 To 42
        With Me.Controls("CommandButton" & i)
            If i >= firstWeekDay And d < last_day Then
                d = d + 1
                .Caption = d
            Else
                .Caption = ""
            End If
        End With
    Next i
    'Call Reset_Colors
End Sub

我觉得这样更整洁一点。