将自定义日历设置为星期一作为一周的第一天

时间:2017-02-28 11:26:30

标签: excel vba excel-vba

我试图找到一个解决方案让我的PoPup日历显示周一的代码作为按钮的开始周。但无论我尝试什么,第一个按钮总是作为美国方式的星期日。但是,由于我来自瑞典,我希望星期一作为本周的第一天......

以下是代码:

Option Explicit
Dim ThisDay As Date
Dim ThisYear, ThisMth As Date
Dim CreateCal As Boolean
Dim i As Integer

Private Sub UserForm_Initialize()
Application.EnableEvents = False
'starts the form on todays date
ThisDay = Date
ThisMth = Format(ThisDay, "mm")
ThisYear = Format(ThisDay, "yyyy")
For i = 1 To 12
    CB_Mth.AddItem Format(DateSerial(Year(Date), Month(Date) + i, 0), "mmmm")
Next
CB_Mth.ListIndex = Format(Date, "mm") - Format(Date, "mm")
For i = -20 To 50
    If i = 1 Then CB_Yr.AddItem Format((ThisDay), "yyyy") Else CB_Yr.AddItem _
        Format((DateAdd("yyyy", (i - 1), ThisDay)), "yyyy")
Next
CB_Yr.ListIndex = 21
'Builds the calendar with todays date
CalendarFrm.Width = CalendarFrm.Width
CreateCal = True
Call Build_Calendar
Application.EnableEvents = True
End Sub


Private Sub CB_Mth_Change()
'rebuilds the calendar when the month is changed by the user
Build_Calendar
End Sub

Private Sub CB_Yr_Change()
'rebuilds the calendar when the year is changed by the user
Build_Calendar
End Sub


Private Sub Build_Calendar()
'the routine that actually builds the calendar each time
If CreateCal = True Then
CalendarFrm.Caption = " " & CB_Mth.Value & " " & CB_Yr.Value

'sets the focus for the todays date button
CommandButton1.SetFocus
For i = 1 To 43
    If i < Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value)) Then
        Controls("D" & (i)).Caption = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _
            ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "d")
        Controls("D" & (i)).ControlTipText = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _
            ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "m/d/yy")
    ElseIf i >= Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value)) Then
        Controls("D" & (i)).Caption = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) _
            & "/1/" & (CB_Yr.Value))), ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "d")
        Controls("D" & (i)).ControlTipText = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _
            ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "m/d/yy")
    End If
    If Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _
    ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "mmmm") = ((CB_Mth.Value)) Then
        If Controls("D" & (i)).BackColor <> &H80000016 Then Controls("D" & (i)).BackColor = &H80000018  '&H80000010
        Controls("D" & (i)).Font.Bold = True
    If Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _
        ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "m/d/yy") = Format(ThisDay, "m/d/yy") Then Controls("D" & (i)).SetFocus
    Else
        If Controls("D" & (i)).BackColor <> &H80000016 Then Controls("D" & (i)).BackColor = &H8000000F
        Controls("D" & (i)).Font.Bold = False
    End If
Next
End If
End Sub


Private Sub D1_Click()
'this sub and the ones following represent the buttons for days on the form
'retrieves the current value of the individual controltiptext and
'places it in the active cell
ActiveCell.Value = D1.ControlTipText
Unload Me
'after unload you can call a different userform to continue data entry
'uncomment this line and add a userform named UserForm2
'Userform2.Show
'This is multiplied for all 43 buttons with Sub D2, Sub D3 and so on.

End Sub

没有给我直接答案,有人可以帮我指出格式化代码在哪里?我的意思是,在哪里说周日是一周的第一天? 或者它是默认的excel? (我在Outlook和Windows设置中的日历设置为英语(英国)格式。)

提前致谢!

1 个答案:

答案 0 :(得分:1)

像这样的东西,在示例中使用2周,所以14个命令按钮,commandbutton1是星期一,并使用以下代码

Dim intBtn As Integer
Dim intDay As Integer

intDay = 1

For intBtn = Weekday(DateSerial(Year(Date), Month(Date), 1), vbMonday) To 14
    Me.Controls("CommandButton" & intBtn).Caption = intDay
    intDay = intDay + 1
Next intBtn

enter image description here