обратный порядок даты в календаре Excel - PullRequest
0 голосов
/ 05 февраля 2020

Я использую пользовательский календарь в Excel, который активируется после двойного щелчка по ячейке. Проблема с порядком месяца и даты в первые 12 дней. Месяц ставится на первое место вместо дня (изменение формата даты на дд мммм гггг не помогает), поэтому макрос ставит 02 мая 2020 года вместо 05 февраля 2020 года.

Проблема возникает только при выборе первых 12 дней в календаре при нажатии на 13-31 календарь помещает дату в правильном формате, поэтому 05 февраля 2020 года. Файл Excel доступен здесь . Ниже вы можете найти весь код:

Dim Buttons() As New clsCmdButton

    Sub Show_Cal()
    'use class module to create commandbutton collection, then show calendar

    Dim iCmdBtns As Integer
    Dim ctl As Control

    iCmdBtns = 0
    For Each ctl In frmCalendar.Controls
      If TypeName(ctl) = "CommandButton"
        Then
      If ctl.Name < > "CB_Close"
        Then
      iCmdBtns = iCmdBtns + 1
      ReDim Preserve Buttons(1 To iCmdBtns)
      Set Buttons(iCmdBtns).CmdBtnGroup = ctl
      End If
      End If
    Next ctl

    frmCalendar.Show

End Sub

Private Sub CB_Close_Click()
        Unload Me
End Sub

Private Sub UserForm_Initialize()

    Dim i As Long
    Dim lYearsAdd As Long
    Dim lYearStart As Long

    lYearStart = Year(Date) - 10
    lYearsAdd = Year(Date) + 10
    With Me
    For i = 1 To 12
        .CB_Mth.AddItem Format(DateSerial(Year(Date), i, 1), "mmmm")
    Next

    For i = lYearStart To lYearsAdd
        .CB_Yr.AddItem Format(DateSerial(i, 1, 1), "yyyy")
    Next

        .Tag = "Calendar"
        .CB_Mth.ListIndex = Month(Date) - 1
        .CB_Yr.ListIndex = Year(Date) - lYearStart
        .Tag = ""
    End With
    Call Build_Calendar

End Sub

Private Sub CB_Mth_Change()
    If Not Me.Tag = "Calendar"
      Then Build_Calendar
End Sub

Private Sub CB_Yr_Change()
    If Not Me.Tag = "Calendar"
        Then Build_Calendar
End Sub

Sub Build_Calendar()

    Dim i As Integer
    Dim dTemp As Date
    Dim dTemp2 As Date
    Dim iFirstDay As Integer
    With Me
        .Caption = " " & .CB_Mth.Value & " " & .CB_Yr.Value

    dTemp = CDate("01/" & .CB_Mth.Value & "/" & .CB_Yr.Value)
    iFirstDay = WeekDay(dTemp, vbSunday)
        .Controls("D" & iFirstDay).SetFocus

    For i = 1 To 42
    With.Controls("D" & i)
    dTemp2 = DateAdd("d", (i - iFirstDay), dTemp)
        .Caption = Format(dTemp2, "d")
        .Tag = dTemp2
        .ControlTipText = Format(dTemp2, "dd/mm/yyyy")
    'add dates to the buttons
    If Format(dTemp2, "mmmm") = CB_Mth.Value Then
    If.BackColor < > & H80000016 Then.BackColor = & H80000018
    If Format(Date, "dd mmmm yyyy") = Format(Date, "dd/mm/yyyy") Then.SetFocus
        .Font.Bold = True
    Else
    If.BackColor < > & H80000016 Then.BackColor = & H8000000F
        .Font.Bold = False
    End If
        'format the buttons
    End With
    Next
    End With

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        If Target.Cells.Count > 1 Then Exit Sub
        If Intersect(Target, Range("DateEntry")) Is Nothing Then Exit Sub
        If Target.Value < > ""
        Then Exit Sub
        Set rngAC = Target
        g_bForm = True
        frmCalendar.Show_Cal
        rngAC.NumberFormat = "dd mmmm yyyy"
        rngAC.Value = g_sDate
        rngAC.EntireColumn.AutoFit
End Sub

1 Ответ

1 голос
/ 05 февраля 2020

Я не могу воспроизвести вашу проблему. Но это звучит как что-то из-за несоответствия между сгенерированной датой и региональными настройками windows.

Попробуйте изменить объявление g_sDate на:

Public g_sDate As Date
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...