我需要在Excel2013中添加日历日期选择器。我认为这很容易,直到我发现MonthView和DT Picker不再出现在ActiveX菜单中,并且据说包含这些的CAB文件的链接不起作用。那里有一些看似优秀的教学文档,但它们依赖于一种不存在的控制。我目前有一个Excel Addin可以满足我的需要,但是我想用VBA来做这件事,而不是在每台将使用它的机器上安装Addin。有什么想法吗?
答案 0 :(得分:4)
一旦您注册了 mscomct2.ocx 控件(您将需要在将使用此工作簿的所有计算机上注册此文件!),您可以添加一个在工作表或用户窗体中的以下控件:
工作表(ActiveX)
答案 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
使用此表单的步骤
答案 4 :(得分:0)
作为 DTPicker 控件的替代方案,可以使用用户表单轻松地将日期添加到活动单元格中。
双击工作表上的任何单元格时会显示日历表单。从用户表单标题上的月份开始,根据用户的系统语言在组合框控件中列出月份。
用户窗体上单击按钮的 ControlTipText 值将作为日期添加到活动单元格中。