title image


Smiley Re: Berechnung von Tagen in einer Tabelle überarbeitet
'Attribute VB_Name = "modTestDateDiff_Tabelle"

Sub TestDateDiff_Tabelle()

Dim aDate, eDate, dDiff

Dim Errmessage

'

'Zellbezug Start: Zeile, Spalte

aDate = Left(ActiveDocument.Tables(1).Cell(2, 4).Range.Text, _

Len(ActiveDocument.Tables(1).Cell(2, 4).Range.Text) - 2)

'

If InStr(1, aDate, ",", vbTextCompare) _

Or InStr(1, aDate, ":", vbTextCompare) > 0 Then

Errmessage = "Anfangsdatum"

Call Fehlermeldung(Errmessage)

Exit Sub

End If

'

'Zellbezug Ende: Zeile, Spalte

eDate = Left(ActiveDocument.Tables(1).Cell(2, 5).Range.Text, _

Len(ActiveDocument.Tables(1).Cell(2, 5).Range.Text) - 2)

'

If InStr(1, eDate, ",", vbTextCompare) _

Or InStr(1, eDate, ":", vbTextCompare) > 0 Then

Errmessage = "Enddatum"

Call Fehlermeldung(Errmessage)

Exit Sub

End If

'

If DateValue(eDate) < DateValue(aDate) Then

MsgBox "Das eingegebene Datum ist bereits verstrichen!" _

& vbCrLf & "Bitte neues End-Datum eingeben.", vbCritical + vbOKOnly, _

String(4, 32) & "Falsche Eingabe"

Exit Sub

End If

'

'Differenz in Tagen

dDiff = DateDiff("d", DateValue(aDate), DateValue(eDate))

ActiveDocument.Tables(3).Cell(2, 5).Range.Text _

= DateDiff("d", DateValue(aDate), DateValue(eDate)) & " Tage"

End Sub

'

Private Sub Fehlermeldung(Errmessage)

sMess = "Das " & Errmessage & " wurde falsch eingegeben!" & vbCrLf _

& "Bitte überprüfen Sie Ihre Eingaben."

MsgBox sMess, vbExclamation + vbOKOnly, String(4, 32) & "Fehler"

End Sub



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: