vba 如何添加日历、日期选择器？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/34534763/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
提示：将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间：2020-09-08 10:08:43 来源:igfitidea点击:
How to add Calendar, Date-Picker?
提问by Don Desrosiers
I need to add a Calendar Date Picker in Excel 2013.
我需要在 Excel 2013 中添加日历日期选择器。
I found that the MonthView and the DT Picker are no longer in the ActiveX menu and the links for a CAB file that supposedly contains these does not work. There are instruction documents, but they rely on a control that doesn't exist.
我发现 MonthView 和 DT Picker 不再位于 ActiveX 菜单中，并且据称包含这些内容的 CAB 文件的链接不起作用。有说明文档，但它们依赖于不存在的控件。
I have an Excel Addin that does what I want, but I want to do this with VBA rather than install the Addin on every machine that will use this.
我有一个 Excel 插件可以做我想要的，但我想用 VBA 来做这个，而不是在每台使用它的机器上安装插件。
回答by PatricK
Once you have registered the mscomct2.ocxcontrol (YOU WILL NEED TO REGISTER THIS FILE ON ALL COMPUTERS THAT WILL USE THIS WORKBOOK!), you can either add one of below controls in the Worksheet or in a UserForm:
一旦您注册了mscomct2.ocx控件（您需要在将使用此工作簿的所有计算机上注册此文件！），您可以在工作表或用户窗体中添加以下控件之一：
- Date and Time Picker (DTPicker), left/top of screenshots
- MonthView, right/bottom of screenshots
- 日期和时间选择器 ( DTPicker)，屏幕截图的左侧/顶部
- MonthView，屏幕截图的右侧/底部
WORKSHEET (ActiveX)
工作表 (ActiveX)
- In Developer tab, Controls group, click Insert, then bottom right
button for More Controls.
- Scroll down and select Microsoft Date and Time Picker Control 6.0 (SP6)or Microsoft MonthView Control 6.0 (SP6)then click OK.|
- When you are out of Design Mode, clicking on the DTPicker control is like this, while the MonthView takes more space:|
- 在“开发工具”选项卡的“控件”组中，单击“插入”，然后单击“更多控件”的右下角按钮。
- 向下滚动并选择Microsoft 日期和时间选择器控件 6.0 (SP6)或Microsoft MonthView Control 6.0 (SP6)，然后单击确定。|
- 当你退出设计模式时，点击DTPicker控件是这样的，而MonthView则占用更多空间：|
UserForm
用户表单
- In the Toolbox for the UserForm selected, right click on empty space of the Controls tab, click Additional Controls
- Scroll down and tick Microsoft Date and Time Picker Control 6.0 (SP6)or Microsoft MonthView Control 6.0 (SP6):|
- Now the controls are in your Controls tab to add on UserForms
- Default size of the controls on UserForm:
- 在所选用户窗体的工具箱中，右键单击控件选项卡的空白区域，单击其他控件
- 向下滚动并勾选Microsoft 日期和时间选择器控件 6.0 (SP6)或Microsoft MonthView Control 6.0 (SP6)：|
- 现在控件位于您的控件选项卡中以添加到用户窗体
- 用户窗体上控件的默认大小：
无论哪种方式，您都需要在单击这些控件时执行操作。
回答by Vishesh
I have used mscomct2.ocx file to use a date picker in excel. You need to register it and can then easily use the date picker
我已经使用 mscomct2.ocx 文件在 excel 中使用日期选择器。您需要注册它，然后才能轻松使用日期选择器
回答by John Muggins
Some users may not have the ability to use your DatePicker if their Excel is not formatted correctly. I developed code that will create a dateGetter userform, get the user's date selection as a Global variable, and then delete the form. It should be compatible with most systems, though I haven't tested it on others than my own. Give it a shot. If it works for you, give me a shout out....
如果 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
回答by Kamal Bharakhda
Using DTPicker (Date Picker) element in VBA Excel Module makes your work unsharable. That happened to me many times. I usually share my works with mates and they weren't able to proceed whenever they have been encountered with DTPicker missing library problems.
在 VBA Excel 模块中使用 DTPicker（日期选择器）元素使您的工作无法共享。这在我身上发生过很多次。我通常与伙伴分享我的作品，每当他们遇到 DTPicker 缺少库的问题时，他们就无法继续。
Installing Microsoft Common Control 2 SP6 and then Register its service is not an everyone's cup of tea. So, Instead of using DTPicker element, I have developed my own Date Picker which is more convenient, easy and applicable.
安装 Microsoft Common Control 2 SP6 然后注册其服务并不是每个人都喜欢的。因此，我没有使用 DTPicker 元素，而是开发了自己的日期选择器，它更方便、简单和适用。
here's the link to the Form File. https://www.dropbox.com/s/bwxtkw03kytcv8v/Form%20Files.rar?dl=0
这是表单文件的链接。 https://www.dropbox.com/s/bwxtkw03kytcv8v/Form%20Files.rar?dl=0
Steps to use this Form
使用此表格的步骤
- Import it
- Now, in your USERFORM, in Date area (textbox), execute my form file with double-click event.
- 导入它
- 现在，在您的 USERFORM 中，在日期区域（文本框）中，使用双击事件执行我的表单文件。
