Excel VBA日历,日期选择器

时间:2015-12-30 18:05:37

标签: excel vba

我需要在Excel2013中添加日历日期选择器。我认为这很容易,直到我发现MonthView和DT Picker不再出现在ActiveX菜单中,并且据说包含这些的CAB文件的链接不起作用。那里有一些看似优秀的教学文档,但它们依赖于一种不存在的控制。我目前有一个Excel Addin可以满足我的需要,但是我想用VBA来做这件事,而不是在每台将使用它的机器上安装Addin。有什么想法吗?

5 个答案:

答案 0 :(得分:4)

一旦您注册了 mscomct2.ocx 控件(您将需要在将使用此工作簿的所有计算机上注册此文件!),您可以添加一个在工作表或用户窗体中的以下控件:

  • 日期和时间选择器( DTPicker ),屏幕截图左侧/顶部
  • MonthView ,屏幕截图的右下角

工作表(ActiveX)

  1. 在“开发者”选项卡的“控制”组中,单击“插入”,然后单击右下角 更多控件的按钮。
    Step1
  2. 向下滚动并选择 Microsoft日期和时间选择器控件6.0(SP6) Microsoft MonthView Control 6.0(SP6),然后单击“确定”。
    {{3 }} | Step2a
  3. 当您退出设计模式时,单击DTPicker控件就像这样,而MonthView占用更多空间:
    Step2b | Step3a
  4. <强>用户窗体

    1. 在所选用户窗体的工具箱中,右键单击“控件”选项卡的空白处,单击“其他控件”Step3b
    2. 向下滚动并勾选 Microsoft日期和时间选择控件6.0(SP6) Microsoft MonthView Control 6.0(SP6)
      form step 1 | form step 2a
    3. 现在控件位于“控件”标签中,以添加用户表格form step 2b
    4. UserForm上控件的默认大小:
      form step 3
    5. <小时/> 无论哪种方式,您都需要在单击这些控件时实施操作。

答案 1 :(得分:1)

我已经使用mscomct2.ocx文件在excel中使用日期选择器。 您需要注册它,然后才能轻松使用日期选择器

答案 2 :(得分:1)

如果Excel的格式不正确,某些用户可能无法使用您的DatePicker。我开发了将创建dateGetter用户表单的代码,将用户的日期选择作为全局变量,然后删除表单。它应该与大多数系统兼容,尽管我还没有在别人身上测试它而不是我自己的系统。试一试。如果它适合你,请给我一个喊叫....

Public absDate As Date
Sub dateGetter()
'   This creates dategetter userform for those without access to date picker
Dim myForm As Object, calendarForm As Object, newLabel As MSForms.Label, newSpinner As MSForms.SpinButton
Dim NewFrame As MSForms.Frame
Dim NewButton As MSForms.CommandButton, newButton2 As MSForms.CommandButton
Dim NewListBox As MSForms.ListBox
Dim smallDayArray
Dim xDiff As Long
Dim smallTextArray
Dim startDate As Date
Dim endDate As Date

    Set myForm = ThisWorkbook.VBProject.VBComponents.Add(3)

    'Create the User Form
    With myForm
        .Properties("Caption") = "Select Date Range"
        .Properties("Width") = 247.5
        .Properties("Height") = 350
    End With

    'create button
    Set NewButton = myForm.designer.Controls.Add("Forms.commandbutton.1")
    With NewButton
        .Name = "CommandButton1"
        .Top = 288
        .Left = 138
        .Width = 42
        .Height = 24
        .Font.Size = 10
        .Font.Name = "Tahoma"
        .Caption = "Cancel"
    End With

    'create button
    Set NewButton = myForm.designer.Controls.Add("Forms.commandbutton.1")
    With NewButton
        .Name = "CommandButton2"
        .Top = 288
        .Left = 186
        .Width = 42
        .Height = 24
        .Font.Size = 10
        .Font.Name = "Tahoma"
        .Caption = "Select"
    End With


    'create frame
    Set NewFrame = myForm.designer.Controls.Add("Forms.frame.1")
    With NewFrame
        .Name = "Frame1"
        .Top = 54
        .Left = 24
        .Width = 192
        .Height = 180
        .Font.Size = 9
        .Font.Name = "Tahoma"
    End With

    'Create label1
    Set newLabel = myForm.designer.Controls.Add("Forms.Label.1")
    With newLabel
        .Name = "Label1"
        .Top = 30
        .Left = 30
        .Width = 102
        .Height = 18
        .Font.Size = 12
        .Font.Name = "Tahoma"
        .ForeColor = RGB(128, 0, 0)
        .BackColor = RGB(256, 256, 256)
        .Caption = "November 2017"
    End With

    'Create label2
    Set newLabel = myForm.designer.Controls.Add("Forms.Label.1")
    With newLabel
        .Name = "Label2"
        .Top = 258
        .Left = 36
        .Width = 174
        .Height = 18
        .Font.Size = 12
        .Font.Name = "Tahoma"
        .ForeColor = RGB(0, 0, 0)
        .Caption = "01/01/2017"
    End With


    'Create SpinButton1
    Set newSpinner = myForm.designer.Controls.Add("Forms.spinbutton.1")
    With newSpinner
        .Name = "SpinButton1"
        .Top = 24
        .Left = 144
        .Width = 12.75
        .Height = 25
    End With

    'Create Calendar Header Labels
    smallDayArray = Array("S", "M", "T", "W", "T", "F", "S")
    smallTextArray = Array("day1", "day2", "day3", "day4", "day5", "day6", "day7")
    xDiff = 18
    For i = LBound(smallDayArray) To UBound(smallDayArray)
        Set lbl = NewFrame.Controls.Add("Forms.Label.1")
        With lbl
            .Name = smallTextArray(i)
            .Top = 6
            .Left = xDiff
            .Width = 12
            .Height = 18
            .Font.Size = 11
            .Font.Name = "Tahoma"
            .Caption = smallDayArray(i)
        End With
        xDiff = xDiff + 24
    Next i

    'Create Calendar boxes labels
    arrCounter = 1
    For j = 1 To 6
        xDiff = 12
        For k = 1 To 7
            Set lbl = NewFrame.Controls.Add("Forms.Label.1")
            With lbl
                .Name = "lb_" & arrCounter
                Select Case j
                    Case 1
                        .Top = 24
                    Case 2
                        .Top = 48
                    Case 3
                        .Top = 72
                    Case 4
                        .Top = 96
                    Case 5
                        .Top = 120
                    Case 6
                        .Top = 144
                End Select
                .Left = xDiff
                .Width = 18
                .Height = 18
                .Font.Size = 11
                .Font.Name = "Tahoma"
                .Caption = " " & arrCounter
                .ForeColor = RGB(128, 0, 0)
                .BackColor = RGB(256, 256, 256)
            End With
            arrCounter = arrCounter + 1
            xDiff = xDiff + 24
        Next k
    Next j

    ''add code for form module
    myForm.codemodule.insertlines 1, "Private Sub CommandButton1_Click()"
    myForm.codemodule.insertlines 2, "absDate = 0"
    myForm.codemodule.insertlines 3, "Unload Me"
    myForm.codemodule.insertlines 4, "End Sub"
    myForm.codemodule.insertlines 5, ""
    myForm.codemodule.insertlines 6, "Private Sub SpinButton1_SpinDown()"
    myForm.codemodule.insertlines 7, "Dim newDate1 As Date"
    myForm.codemodule.insertlines 8, "    newDate1 = DateValue(Left(Label1.Caption, Len(Label1.Caption) - 5) & " & Chr(34) & " 1, " & Chr(34) & " & Right(Label1.Caption, 4))"
    myForm.codemodule.insertlines 9, "    newDate1 = DateAdd(" & Chr(34) & "m" & Chr(34) & ", -1, newDate1)"
    myForm.codemodule.insertlines 10, "    Label1.Caption = MonthName(Month(newDate1)) & " & Chr(34) & " " & Chr(34) & " & Year(newDate1)"
    myForm.codemodule.insertlines 11, "    Call clearBoxes"
    myForm.codemodule.insertlines 12, "   Run fillCal(newDate1)"
    myForm.codemodule.insertlines 13, "End Sub"
    myForm.codemodule.insertlines 14, "Private Sub SpinButton1_SpinUp()"
    myForm.codemodule.insertlines 15, "Dim newDate1 As Date"
    myForm.codemodule.insertlines 16, "    newDate1 = DateValue(Left(Label1.Caption, Len(Label1.Caption) - 5) & " & Chr(34) & " 1, " & Chr(34) & " & Right(Label1.Caption, 4))"
    myForm.codemodule.insertlines 17, "    newDate1 = DateAdd(" & Chr(34) & "m" & Chr(34) & ", 1, newDate1)"
    myForm.codemodule.insertlines 18, "    Label1.Caption = MonthName(Month(newDate1)) & " & Chr(34) & " " & Chr(34) & " & Year(newDate1)"
    myForm.codemodule.insertlines 19, "    Call clearBoxes"
    myForm.codemodule.insertlines 20, "    Run fillCal(newDate1)"
    myForm.codemodule.insertlines 21, "End Sub"
    myForm.codemodule.insertlines 22, "Function dhDaysInMonth2(Optional dtmDate As Date = 0) As Integer"
    myForm.codemodule.insertlines 23, "    ' Return the number of days in the specified month.  Written by Chip Pierson"
    myForm.codemodule.insertlines 24, "    If dtmDate = 0 Then"
    myForm.codemodule.insertlines 25, "        ' Did the caller pass in a date? If not, use"
    myForm.codemodule.insertlines 26, "        ' the current date."
    myForm.codemodule.insertlines 27, "        dtmDate = Date"
    myForm.codemodule.insertlines 28, "    End If"
    myForm.codemodule.insertlines 29, "    dhDaysInMonth2 = DateSerial(Year(dtmDate), _ "
    myForm.codemodule.insertlines 30, "     Month(dtmDate) + 1, 1) - _ "
    myForm.codemodule.insertlines 31, "     DateSerial(Year(dtmDate), Month(dtmDate), 1)"
    myForm.codemodule.insertlines 32, "End Function"
    myForm.codemodule.insertlines 33, "Public Sub UserForm_Activate()"
    myForm.codemodule.insertlines 34, "Dim currentDate As Date"
    myForm.codemodule.insertlines 35, ""
    myForm.codemodule.insertlines 36, " For i = 1 To 42" & vbNewLine
    myForm.codemodule.insertlines 37, "     txt = txt & " & Chr(34) & "Private Sub lb_" & Chr(34) & " & i & " & Chr(34) & "_Click()" & Chr(34) & " & vbNewLine" & vbNewLine
    myForm.codemodule.insertlines 38, "     txt = txt & " & Chr(34) & "Dim newDate As Date" & Chr(34) & " & vbNewLine" & vbNewLine
    myForm.codemodule.insertlines 39, " txt = txt & " & Chr(34) & "newDate = DateValue(Mid(Label1.Caption, 1, Len(Label1.Caption) - 5) &" & Chr(34) & " & Chr(34) &   " & Chr(34) & Chr(34) & " & lb_" & " & i & " & Chr(34) & ".Caption & " & Chr(34) & " & Chr(34) & " & Chr(34) & ", " & Chr(34) & " & Chr(34) & " & Chr(34) & " & Right(Label1.Caption, 4))" & Chr(34) & " & vbNewLine" & vbNewLine
    myForm.codemodule.insertlines 40, "     txt = txt & " & Chr(34) & "Label2.Caption = " & Chr(34) & " & Chr(34) & " & Chr(34) & "Date:  " & Chr(34) & " & Chr(34) & " & Chr(34) & " & newDate" & Chr(34) & " & vbNewLine" & vbNewLine
    myForm.codemodule.insertlines 41, "txt = txt & " & Chr(34) & "End Sub" & Chr(34) & " & vbNewLine" & vbNewLine
    myForm.codemodule.insertlines 42, "Next i" & vbNewLine
    myForm.codemodule.insertlines 43, ""
    myForm.codemodule.insertlines 44, "Label2.Caption =  Chr(34) &  Chr(34) "
    myForm.codemodule.insertlines 45, "currentDate = DateValue(Month(Date) & " & Chr(34) & " 1" & Chr(34) & " & " & Chr(34) & ", " & Chr(34) & " & Year(Date))"
    myForm.codemodule.insertlines 46, "Run fillCal(currentDate)"
    myForm.codemodule.insertlines 47, "End Sub"
    myForm.codemodule.insertlines 48, "Function fillCal(startDate As Date)"
    myForm.codemodule.insertlines 49, "Dim currentDayOfMonth As Integer, i As Integer"
    myForm.codemodule.insertlines 50, "currentDayOfMonth = Day(Date)"
    myForm.codemodule.insertlines 51, "Dim startCal As Date, currentMonth as Integer"
    myForm.codemodule.insertlines 52, "Dim labelArray, sumVar3 As Long"
    myForm.codemodule.insertlines 53, "    Label2.Caption = " & Chr(34) & "" & Chr(34)
    myForm.codemodule.insertlines 54, "    labelArray = Array(" & Chr(34) & "lb_1" & Chr(34) & ", " & Chr(34) & "lb_2" & Chr(34) & ", " & Chr(34) & "lb_3" & Chr(34) & ", " & Chr(34) & "lb_4" & Chr(34) & ", " & Chr(34) & "lb_5" & Chr(34) & ", " & Chr(34) & "lb_6" & Chr(34) & ", " & Chr(34) & "lb_7" & Chr(34) & ", " & Chr(34) & "lb_8" & Chr(34) & ", " & Chr(34) & "lb_9" & Chr(34) & ", " & Chr(34) & "lb_10" & Chr(34) & ", " & Chr(34) & "lb_11" & Chr(34) & ", " & Chr(34) & "lb_12" & Chr(34) & ", " & Chr(34) & "lb_13" & Chr(34) & ", " & Chr(34) & "lb_14" & Chr(34) & ", " & Chr(34) & "lb_15" & Chr(34) & ",  _"
    myForm.codemodule.insertlines 55, "                      " & Chr(34) & "lb_16" & Chr(34) & ", " & Chr(34) & "lb_17" & Chr(34) & ", " & Chr(34) & "lb_18" & Chr(34) & ", " & Chr(34) & "lb_19" & Chr(34) & ", " & Chr(34) & "lb_20" & Chr(34) & ", " & Chr(34) & "lb_21" & Chr(34) & ", " & Chr(34) & "lb_22" & Chr(34) & ", " & Chr(34) & "lb_23" & Chr(34) & ", " & Chr(34) & "lb_24" & Chr(34) & ", " & Chr(34) & "lb_25" & Chr(34) & ", " & Chr(34) & "lb_26" & Chr(34) & ", " & Chr(34) & "lb_27" & Chr(34) & ", " & Chr(34) & "lb_28" & Chr(34) & ", " & Chr(34) & "lb_29" & Chr(34) & ", " & Chr(34) & "lb_30" & Chr(34) & ", " & Chr(34) & "lb_31" & Chr(34) & ", _"
    myForm.codemodule.insertlines 56, "                      " & Chr(34) & "lb_32" & Chr(34) & ", " & Chr(34) & "lb_33" & Chr(34) & ", " & Chr(34) & "lb_34" & Chr(34) & ", " & Chr(34) & "lb_35" & Chr(34) & ", " & Chr(34) & "lb_36" & Chr(34) & ", " & Chr(34) & "lb_37" & Chr(34) & ", " & Chr(34) & "lb_38" & Chr(34) & ", " & Chr(34) & "lb_39" & Chr(34) & ", " & Chr(34) & "lb_40" & Chr(34) & ", " & Chr(34) & "lb_41" & Chr(34) & ", " & Chr(34) & "lb_42" & Chr(34) & ")"
    myForm.codemodule.insertlines 57, "    Label1 = MonthName(Month(startDate)) & " & Chr(34) & " " & Chr(34) & " & Year(startDate)"
    myForm.codemodule.insertlines 58, "    sumVar3 = Weekday(startDate) - 1"
    myForm.codemodule.insertlines 59, "    "
    myForm.codemodule.insertlines 60, "    For i = LBound(labelArray) To UBound(labelArray)"
    myForm.codemodule.insertlines 61, "            Me.Controls(labelArray(i)).Caption = " & Chr(34) & "" & Chr(34) & ""
    myForm.codemodule.insertlines 62, "    Next i"
    myForm.codemodule.insertlines 63, "    "
    myForm.codemodule.insertlines 64, "     For i = 1 To dhDaysInMonth2(startDate)"
    myForm.codemodule.insertlines 65, "         Me.Controls(labelArray(sumVar3)).Caption = i"
    myForm.codemodule.insertlines 66, "         If currentDayOfMonth = i And month(Date) = Month(StartDate)  And Year(Date) = Year(StartDate) Then"
    myForm.codemodule.insertlines 67, "             Me.Controls(labelArray(sumVar3)).BackColor = RGB(256, 0, 0)"
    myForm.codemodule.insertlines 68, "             Me.Controls(labelArray(sumVar3)).ForeColor = RGB(256, 256, 256)"
    myForm.codemodule.insertlines 69, "             Label2.Caption = " & Chr(34) & "Date:  " & Chr(34) & " & DateValue(Month(startDate) & " & Chr(34) & "/" & Chr(34) & " & i & " & Chr(34) & "/" & Chr(34) & " & Year(startDate))"
    myForm.codemodule.insertlines 70, "        End If"
    myForm.codemodule.insertlines 71, "        sumVar3 = sumVar3 + 1"
    myForm.codemodule.insertlines 72, "     Next i"
    myForm.codemodule.insertlines 73, "    "
    myForm.codemodule.insertlines 74, "End Function"
    myForm.codemodule.insertlines 75, "Private Sub CommandButton2_Click()"
    myForm.codemodule.insertlines 76, "Unload Me"
    myForm.codemodule.insertlines 77, "End Sub"
    myForm.codemodule.insertlines 78, "Private Sub clearBoxes()"
    myForm.codemodule.insertlines 79, "Dim labelArray"
    myForm.codemodule.insertlines 80, "     Label2.Caption = " & Chr(34) & "" & Chr(34)
    myForm.codemodule.insertlines 81, "     labelArray = Array(" & Chr(34) & "lb_1" & Chr(34) & ", " & Chr(34) & "lb_2" & Chr(34) & ", " & Chr(34) & "lb_3" & Chr(34) & ", " & Chr(34) & "lb_4" & Chr(34) & ", " & Chr(34) & "lb_5" & Chr(34) & ", " & Chr(34) & "lb_6" & Chr(34) & ", " & Chr(34) & "lb_7" & Chr(34) & ", " & Chr(34) & "lb_8" & Chr(34) & ", " & Chr(34) & "lb_9" & Chr(34) & ", " & Chr(34) & "lb_10" & Chr(34) & ", " & Chr(34) & "lb_11" & Chr(34) & ", " & Chr(34) & "lb_12" & Chr(34) & ", " & Chr(34) & "lb_13" & Chr(34) & ", " & Chr(34) & "lb_14" & Chr(34) & ", " & Chr(34) & "lb_15" & Chr(34) & ",  _"
    myForm.codemodule.insertlines 82, "                      " & Chr(34) & "lb_16" & Chr(34) & ", " & Chr(34) & "lb_17" & Chr(34) & ", " & Chr(34) & "lb_18" & Chr(34) & ", " & Chr(34) & "lb_19" & Chr(34) & ", " & Chr(34) & "lb_20" & Chr(34) & ", " & Chr(34) & "lb_21" & Chr(34) & ", " & Chr(34) & "lb_22" & Chr(34) & ", " & Chr(34) & "lb_23" & Chr(34) & ", " & Chr(34) & "lb_24" & Chr(34) & ", " & Chr(34) & "lb_25" & Chr(34) & ", " & Chr(34) & "lb_26" & Chr(34) & ", " & Chr(34) & "lb_27" & Chr(34) & ", " & Chr(34) & "lb_28" & Chr(34) & ", " & Chr(34) & "lb_29" & Chr(34) & ", " & Chr(34) & "lb_30" & Chr(34) & ", " & Chr(34) & "lb_31" & Chr(34) & ", _"
    myForm.codemodule.insertlines 83, "                      " & Chr(34) & "lb_16" & Chr(34) & ", " & Chr(34) & "lb_17" & Chr(34) & ", " & Chr(34) & "lb_18" & Chr(34) & ", " & Chr(34) & "lb_19" & Chr(34) & ", " & Chr(34) & "lb_20" & Chr(34) & ", " & Chr(34) & "lb_21" & Chr(34) & ", " & Chr(34) & "lb_22" & Chr(34) & ", " & Chr(34) & "lb_23" & Chr(34) & ", " & Chr(34) & "lb_24" & Chr(34) & ", " & Chr(34) & "lb_25" & Chr(34) & ", " & Chr(34) & "lb_26" & Chr(34) & ", " & Chr(34) & "lb_27" & Chr(34) & ", " & Chr(34) & "lb_28" & Chr(34) & ", " & Chr(34) & "lb_29" & Chr(34) & ", " & Chr(34) & "lb_30" & Chr(34) & ", " & Chr(34) & "lb_31" & Chr(34) & ", _"
    myForm.codemodule.insertlines 84, "                      " & Chr(34) & "lb_32" & Chr(34) & ", " & Chr(34) & "lb_33" & Chr(34) & ", " & Chr(34) & "lb_34" & Chr(34) & ", " & Chr(34) & "lb_35" & Chr(34) & ", " & Chr(34) & "lb_36" & Chr(34) & ", " & Chr(34) & "lb_37" & Chr(34) & ", " & Chr(34) & "lb_38" & Chr(34) & ", " & Chr(34) & "lb_39" & Chr(34) & ", " & Chr(34) & "lb_40" & Chr(34) & ", " & Chr(34) & "lb_41" & Chr(34) & ", " & Chr(34) & "lb_42" & Chr(34) & ")"
    myForm.codemodule.insertlines 85, "      For i = lbound(labelArray) to ubound(labelArray)"
    myForm.codemodule.insertlines 86, "         Me.Controls(labelArray(i)).BackColor = RGB(256, 256, 256)"
    myForm.codemodule.insertlines 87, "         Me.Controls(labelArray(i)).ForeColor = RGB(0, 0, 0)"
    myForm.codemodule.insertlines 88, "      next i"
    myForm.codemodule.insertlines 89, "End Sub"


    '   add click controls for date label boxes
    Dim myCounter As Long
    myCounter = 90
        For i = 1 To 42
            myForm.codemodule.insertlines myCounter, "Private Sub lb_" & i & "_Click()"
            myCounter = myCounter + 1
            myForm.codemodule.insertlines myCounter, "Dim newDate As Date"
            myCounter = myCounter + 1
            myForm.codemodule.insertlines myCounter, "Call clearBoxes"
            myCounter = myCounter + 1
            myForm.codemodule.insertlines myCounter, "absDate = DateValue(Left(Label1.Caption, Len(Label1.Caption) - 5) & " & Chr(34) & Chr(32) & Chr(34) & " & lb_" & i & ".Caption & " & Chr(34) & ", " & Chr(34) & Chr(38) & " Right(Label1.Caption, 4))"
            myCounter = myCounter + 1
            myForm.codemodule.insertlines myCounter, "Label2.Caption = " & Chr(34) & "Date:  " & Chr(34) & " & absDate" & vbNewLine
            myCounter = myCounter + 1
            myForm.codemodule.insertlines myCounter, "lb_" & i & ".backcolor = rgb(256,0,0)"
            myCounter = myCounter + 1
            myForm.codemodule.insertlines myCounter, "lb_" & i & ".forecolor = rgb(256,256,256)"
            myCounter = myCounter + 1
            myForm.codemodule.insertlines myCounter, "End Sub" & vbNewLine
            myCounter = myCounter + 1
    Next i



    'Add and show new userform
    absDate = 0
    Set calendarForm = VBA.UserForms.Add(myForm.Name)
    calendarForm.Show


    If absDate <> 0 Then
    '   Here is where you put your code to to use the selected date
    '   whhich is in the global variabole "absDate"
        startDate = absDate
        Debug.Print "Your First Date is " & startDate
    Else
        Beep
        MsgBox "You did not select a date"
        GoTo endItAll
    End If


    '   If you would like to get a second date ( for range of dates) before the form is deleted
    '   then just add this code
    absDate = 0
    Set calendarForm = VBA.UserForms.Add(myForm.Name)
    calendarForm.Show
    If absDate <> 0 Then
    '   put additional code here for the second date
        endDate = absDate
        Debug.Print "Your Second Date is " & endDate
    Else
        Beep
        MsgBox "You did not select a date"
    End If


endItAll:
    '   Uncomment the following line if you want to delete the form after using it
    ThisWorkbook.VBProject.VBComponents.Remove myForm

End Sub

Function dhDaysInMonth(Optional dtmDate As Date = 0) As Integer
    ' Return the number of days in the specified month.  Written by Chip Pierson
    If dtmDate = 0 Then
        ' Did the caller pass in a date? If not, use
        ' the current date.
        dtmDate = Date
    End If
    dhDaysInMonth2 = DateSerial(Year(dtmDate), _
     Month(dtmDate) + 1, 1) - _
     DateSerial(Year(dtmDate), Month(dtmDate), 1)
End Function

答案 3 :(得分:0)

在VBA Excel模块中使用DTPicker(日期选择器)元素可使您的工作无法使用。这发生在我身上很多次。我通常与配偶分享我的作品,当遇到DTPicker缺少库问题时,他们无法继续进行。

安装Microsoft Common Control 2 SP6然后注册其服务并不是每个人的一杯茶。因此,我开发了自己的日期选择器,而不是使用DTPicker元素,更方便,更容易和适用。

这里是表单文件的链接。 https://www.dropbox.com/s/bwxtkw03kytcv8v/Form%20Files.rar?dl=0

使用此表单的步骤

  1. 导入
  2. 现在,在您的USERFORM中,在日期区域(文本框)中,使用双击事件执行我的表单文件。
  3. enter image description here

答案 4 :(得分:0)

作为 DTPicker 控件的替代方案,可以使用用户表单轻松地将日期添加到活动单元格中。

enter image description here

双击工作表上的任何单元格时会显示日历表单。从用户表单标题上的月份开始,根据用户的系统语言在组合框控件中列出月份。

用户窗体上单击按钮的 ControlTipText 值将作为日期添加到活动单元格中。

Source (sample file can be downloaded here)