Question

这是我第一次在Stackoverflow上发帖。我试图找到我的问题的答案，虽然这个问题似乎已经解决了其他语言我没有看到任何VBA特定的解决方案，所以我想我发布在这里。如果我的尽职调查不充分，我很抱歉，我感谢任何帮助。

基本上，我想知道在用户表单上输入的给定日期是否在哪个日光节约时间有效。我想让代码评估dst是否生效，如果是，请填写第二个文本框，其中包含“夏令时”或“

”的消息

以下是我提出的代码

Private Sub dtefrm_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

Dim dte
Dim dstdte As Boolean


Let dte = CDate(Me.dtefrm.Value)


Select Case dte
    Case dte > CDate("3/9/2008") And dte < CDate("11/2/2008")
        dstdte = True
        Me.dayconf.Value = "Daylight Savings"

    End Select


End Sub

在此代码中，dtefrm是用户输入日期的用户窗体上的文本框的名称，而dayconf是如果输入的日期是DST日期，我想在其上显示消息的文本框。

感谢您提供任何帮助。

Answer 1

我建议不需要管理的更永久的解决方案。因此，如果DST规则发生变化，您应该受到保护。

步骤1 - 创建一个将为您执行IsDaylightSavingsTime调用的VB.NET DLL。它足够聪明，可以处理代码不会考虑的大量信息。

代码应如下所示。

将DLL命名为DateTimeDstChecker，使其为DateTimeDstChecker.dll

<Serializable(), ClassInterface(ClassInterfaceType.AutoDual), ComVisible(True)>
Public Class DateTimeDstChecker

    Public Function IsDst(ByVal checkDate As DateTime) As Boolean
        Return TimeZoneInfo.Local.IsDaylightSavingTime(thisTime)
    End Function
End Class

第2步 - 添加参考

Once you compile your assembly, you should be able to include a reference to it within VBA by going to "Tools > References" and find DateTimeDstChecker

第3步 - 对VBA进行编码

' Define the Variable
Dim checker As DateTimeDstChecker

' Instantiate the Var
Set checker = New DateTimeDstChecker

' Get the Information
isDst = checker.IsDst(CDate(Me.dtefrm.Value))

Answer 2

    Function IsDST(DateCheck As Date, StartMonth As Integer, StartWeek As Integer, EndMonth As Integer, EndWeek As Integer, DOW_EN As String) As Boolean
    'DO NOT REMOVE
    'It takes nothing away from what you do
    'Gives me credit for creating an International Daylight Saving Time Routine
    '
    'Michel Sabourin (c)2018
    'mpsabourin@gmail.com
    '
    'Will be true if DST is active on specified date given the DST rules for your State/Country
    '
        Dim Param As Boolean, StartDateDST As Date, EndDateDST As Date
        Param = True
        If Not IsDate(DateCheck) Then Param = False
        If StartMonth < 1 Or StartMonth > 12 Then Param = False
        If StartWeek < 1 Or StartWeek > 5 Then Param = False
        If EndMonth < 1 Or EndMonth > 12 Then Param = False
        If EndWeek < 1 Or EndWeek > 5 Then Param = False
        DOW_EN = UCase(DOW_EN)
        If DOW_EN <> "SATURDAY" And DOW_EN <> "SUNDAY" Then Param = False
        If Not Param Then
            MsgBox "IsDST(DateCheck As Date, StartMonth As Integer, StartWeek As Integer, EndMonth As Integer, EndWeek As Integer, DOW_EN As String) As Boolean" _
            & Chr(10) & "DateCheck = Today's date or Date being checked" _
            & Chr(10) & "StartMonth & EndMonth = Whole number (1 - 12) start of DST and end of DST" _
            & Chr(10) & "StartWeek & EndWeek = Whole number (1 - 5) = 1st, 2nd, 3rd, 4th or 5= LAST" _
            & Chr(10) & "Changeover Day of Week = ""Saturday"" or ""Sunday""" _
            , vbOKOnly, "USAGE"
            IsDST = Null
        Else
            StartDateDST = NextDOW(DateSerial(Year(DateCheck), StartMonth, FirstPotentialDate(Year(DateCheck), StartMonth, StartWeek)), DOW_EN)
            EndDateDST = NextDOW(DateSerial(Year(DateCheck), EndMonth, FirstPotentialDate(Year(DateCheck), EndMonth, EndWeek)), DOW_EN)
            IsDST = DateCheck >= StartDateDST And DateCheck < EndDateDST
        End If
    End Function

    Function NextDOW(MyPotentialDate As Date, DOW_EN As String) As Date
    'DO NOT REMOVE
    'It takes nothing away from what you do
    'Gives me credit for creating an International Daylight Saving Time Routine
    '
    'Michel Sabourin (c)2018
    'mpsabourin@gmail.com
    '
        'Next Date from Potential start for that particular date
        Dim MyWeekDay As Integer
        DOW_EN = UCase(DOW_EN)
        If Not IsDate(MyPotentialDate) Then DOW_EN = ""
        Select Case DOW_EN
        Case "SUNDAY"
            NextDOW = MyPotentialDate + 7 - Weekday(MyPotentialDate, vbMonday)
        Case "SATURDAY"
            NextDOW = MyPotentialDate + 7 - Weekday(MyPotentialDate, vbSunday)
        Case Else
            MsgBox "NextDOW(MyDate As Date, DOW_EN As String) As Date" _
            & Chr(10) & "MyDate = First Potential Date" _
            & Chr(10) & """Saturday"" or ""Sunday""" _
            , vbOKOnly, "USAGE"
            NextDOW = Null
        End Select
    End Function

    Function FirstPotentialDate(MyYear As Integer, MyMonth As Integer, MyWeek As Integer) As Integer
    'DO NOT REMOVE
    'It takes nothing away from what you do
    'Gives me credit for creating an International Daylight Saving Time Routine
    '
    'Michel Sabourin (c)2018
    'mpsabourin@gmail.com
    '
        If MyWeek < 5 Then
            FirstPotentialDate = 1 + 7 * (MyWeek - 1)
        Else
            FirstPotentialDate = Day(DateSerial(MyYear, (MyMonth \ 12) + 1, 1) - 7)
        End If
    End Function

VBA中的夏令时计算

2 个答案: