VBA计算工资的付款日期（Access DB）

我正在编程一个Access付款工资数据库，并且薪水应该在每月的第14个月支付。如果是周末或假期，那么应该是13日，12日，11日等（14日前的最后一个工作日）。我们的周末是周五和周六 - 平日（dteDate，vbSunday）VBA计算工资的付款日期（Access DB）

我的挑战是，当VBA进行计算时，我没有得到正确的值。首先检查它是否是周末，然后减少一两天（取决于是星期六还是星期天），然后测试它是否是假期（[tblHoliday]。[tblHoliday]）。如果是，那么减少一天 - 直到它不再是假期。然后它会测试是否是周末，如果是，则减少正确的天数，然后再测试一次是否是假期。如果不是，则返回日期。

我在比较数据库

Private Sub PeriodeEnd_Text_AfterUpdate() 

Dim dtDate As Date 
Dim testDate As Date 

    dtDate = dhLastDayInMonth(Me.PeriodeEnd_Text) + 14 
    testDate = LastWorkDay(dtDate) 

Me.PaymentDay_Text = testDate 

End Sub

使用这种和模块

Function dhLastDayInMonth(Optional dtmDate As Date = 0) As Date 
    ' Return the last day in the specified month. 
    If dtmDate = 0 Then 
     ' Did the caller pass in a date? If not, use 
     ' the current date. 
     dtmDate = Date 
    End If 
    dhLastDayInMonth = DateSerial(Year(dtmDate), _ 
    Month(dtmDate) + 1, 0) 
End Function 

    Public Function LastWorkDay(Dt As Date) As Date 

    Dim Searching As Boolean 
    Searching = True 

    Do While Searching 
     If Weekday(LastWorkDay, vbSunday) > 5 Then 
     '-- Weekend day, back up a day 
     LastWorkDay = LastWorkDay - 1 
     Else 
     If Weekday(LastWorkDay, vbSunday) > 5 Or _ 
      Not IsNull(DLookup("[HolidayDate]", "tblHoliday", _ 
           "[HolidayDate] = " & Format(LastWorkDay, "\#mm\/dd\/yyyy\#;;;\N\u\l\l"))) Then 
      '-- The above Format of LastWorkday works with US or UK dates! 
      LastWorkDay = LastWorkDay - 1 
     Else 
      '-- The search is over 
      Searching = False 
     End If 
     End If 
    Loop 
End Function

来源

2016-07-22 Thomas Formo Riise

你能提供你使用的代码吗？ –

'Dt'是你的'LastWorkDay'函数的参数，但你永远不会使用它。您可能需要在循环的开始处包含“LastWorkDay = Dt”行，或将其设置为在整个函数中使用“Dt”，然后在末尾设置“LastWorkDay = Dt”。 – OpiesDad

嗨，感谢您的帮助，我测试了它，但它失败了。当周末结束时，以及（在我的情况下）周末前的最后一个工作日是星期四，如果这是一个假期，整个Access程序就会陷入僵局。我必须重新启动程序。幸运的是，戴夫的以下建议正在起作用。如果你很容易明白我的代码为什么不起作用，那对我的记录来说会很好。 –

我敢肯定有清洁剂的答案中有这个，但也许试试这个？

亲切的问候

Function WhenIsNextPayDate() As Date 

Dim dteIn7days As Date 
Dim dteTemp As Date 
Dim intDayOfWeek As Integer 
Dim blnNonPayDate As Boolean 

'I have used the actual 2016 easter holiday dates in Oz and 
'pretended that your pay day was actually the 28th (a Monday) 
'We are imagining today is the 21st of March 2016 and 
'that we would like to know the pay date at least a week ahead 

dteIn7days = #3/21/2016# + 7 

If DatePart("d", dteIn7days) = 28 Then 

    'Keep going back in time until pay day is not Saturday, Sunday or a public holiday 
    dteTemp = dteIn7days 
    Do 

     blnNonPayDate = False 

     intDayOfWeek = DatePart("w", dteTemp) 

     Select Case intDayOfWeek 

      Case vbSaturday '7 

       blnNonPayDate = True 
      Case vbSunday '1 

       blnNonPayDate = True 
      Case Else 

       '(I imagine you already have a function to test a date 
       'in the public holiday table) 
       'This is to illustrate the case of 2 public holidays 
       'Easter friday and easter monday 
       If dteTemp = #3/25/2016# Or dteTemp = #3/28/2016# Then 

        blnNonPayDate = True 
       End If 
     End Select 

     If blnNonPayDate = False Then 

      'Pay day - thursday 24th March 2016 
      WhenIsNextPayDate = dteTemp 
      Debug.Print WhenIsNextPayDate 
      Exit Do 
     Else 

      'Keep going back in time 
      dteTemp = dteTemp - 1 
     End If 
    Loop 
End If 

End Function

来源

2016-07-22 15:09:41

嗨戴夫，谢谢，代码现在正在工作。请参阅主要问题栏，它显示了我最终的结果。 –

（发布代表OP）的。

这是最后的代码正在工作！

Private Sub PeriodeEnd_Text_AfterUpdate() 

Dim dtDate As Date 
Dim testDate As Date 

    dtDate = dhLastDayInMonth(Me.PeriodeEnd_Text) + 14 
    testDate = WhenIsNextPayDate(dtDate) 

Me.PaymentDay_Text = testDate 

End Sub 

Function dhLastDayInMonth(Optional dtmDate As Date = 0) As Date 
     ' Return the last day in the specified month. 
     If dtmDate = 0 Then 
      ' Did the caller pass in a date? If not, use 
      ' the current date. 
      dtmDate = Date 
     End If 
     dhLastDayInMonth = DateSerial(Year(dtmDate), _ 
     Month(dtmDate) + 1, 0) 
    End Function 

Function WhenIsNextPayDate(Dt As Date) As Date 

Dim dteIn7days As Date 
Dim dteTemp As Date 
Dim intDayOfWeek As Integer 
Dim blnNonPayDate As Boolean 

'I have used the actual 2016 easter holiday dates in Oz and 
'pretended that your pay day was actually the 28th (a Monday) 
'We are imagining today is the 21st of March 2016 and 
'that we would like to know the pay date at least a week ahead 

dteIn7days = Dt 

If DatePart("d", dteIn7days) = 14 Then 

    'Keep going back in time until pay day is not Saturday, Sunday or a public holiday 
    dteTemp = dteIn7days 
    Do 

     blnNonPayDate = False 

     intDayOfWeek = DatePart("w", dteTemp) 

     Select Case intDayOfWeek 

      Case vbFriday '7 

       blnNonPayDate = True 
      Case vbSaturday '1 

       blnNonPayDate = True 
      Case Else 

       '(I imagine you already have a function to test a date 
       'in the public holiday table) 
       'This is to illustrate the case of 2 public holidays 
       'Easter friday and easter monday 
       If Not IsNull(DLookup("[HolidayDate]", "tblHoliday", "[HolidayDate] = " & Format(dteTemp, "\#mm\/dd\/yyyy\#;;;\N\u\l\l"))) Then 

        blnNonPayDate = True 
       End If 
     End Select 

     If blnNonPayDate = False Then 

      'Pay day - thursday 24th March 2016 
      WhenIsNextPayDate = dteTemp 
      Debug.Print WhenIsNextPayDate 
      Exit Do 
     Else 

      'Keep going back in time 
      dteTemp = dteTemp - 1 
     End If 
    Loop 
End If 

End Function

来源

2016-07-22 22:23:52 halfer

VBA计算工资的付款日期（Access DB）

回答

相关问题