VBA, um Zahlungstag für Gehalt zu berechnen (Access DB)

Question

Ich programmiere ein Access Payment Gehalt DB, und die Gehälter sollten die 14 jeden Monat bezahlt werden. Wenn es ein Wochenende oder ein Feiertag ist, dann sollte es der 13., 12., 11. usw. sein (der letzte Arbeitstag vor dem 14.). Unsere Wochenenden sind Freitag und Samstag - Wochentag (dteDate, vbSunday)

Meine Herausforderung ist, dass ich nicht den richtigen Wert bekomme, wenn der VBA die Berechnung durchführt. Zuerst prüft es, ob es sich um ein Wochenende handelt, reduziert dann ein oder zwei Tage (hängt davon ab, ob es sich um einen Samstag oder Sonntag handelt) und sollte dann testen, ob es sich um einen Feiertag handelt ([tblHoliday]. [TblHoliday]). Wenn ja, dann reduziere es mit einem Tag - bis es kein Feiertag mehr ist. Dann sollte es testen, ob es ein Wochenende ist, wieder, wenn ja, reduzieren Sie die korrekte Anzahl von Tagen, und testen Sie dann, ob es wieder Urlaub ist. Wenn nicht, dann gebe das Datum zurück.

Ich verwende diese in dem Vergleich Database

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 

Und habe diese in einem Modul

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 

Answer 1

Ich bin sicher, dass es saubere Antworten, aber vielleicht versuche diese?

Mit freundlichen Grüßen

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 

Answer 2

(Geschrieben im Auftrag des OP).

Hier ist der letzte Code, der funktioniert!

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