' vb@rchiv - Das große Visual-Basic Archiv
' Tools & Components - Entwicklerkomponenten für VB-32 Bit
'
' Copyright ©2000-2002 Dieter Otter
'
' Der Programmcode darf für eigene Zwecke verwendet werden.
' Es ist nicht erlaubt Inhalte des Projektes ohne unserer
' Zustimmung zum Download anzubieten.
'
' Die Beispielskripte sind Computerprogramme, die gemäß
' des §2 Abs. 1 Nr. 69 aff. UrhG den urheberrechtlichen
' Schutz geniessen und dürfen nicht für eigene ausgegeben
' werden.
'
' Dieter Otter
' Software-Entwicklung & Vertrieb
' info@vbarchiv.de
' http://www.vbarchiv.de
' http://www.vbarchiv.net
'
' info@tools4vb.de
' http://www.tools4vb.de
'======================================================
Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
  ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
  ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As _
  Long) As Long
Public Monate As Integer
Public Tage As Integer
 
Public Function Alter(ByVal sGebDat As String, _
  Optional ByVal sNow As String = "") As Integer
 
  Dim iYears As Long
  Dim iMonth As Integer
  Dim iDays As Integer
  Dim lDateCurrent As Long
  Dim lDateBirthday As Long
  Dim sTemp As String
 
  iYears = 0
 
  ' korrekte Datumsangabe?
  ' Format: tt.mm.yyyy
  If Len(sGebDat) = 10 And _
    Mid$(sGebDat, 3, 1) = "." And Mid$(sGebDat, 6, 1) = "." Then
 
    ' Falls sNow nicht angegeben wurde, wird
    ' jetzt das aktuelle Tagesdatum für die Altersberechnung
    ' herangezogen
    If sNow = "" Then sNow = Format$(Now, "dd.mm.yyyy")
 
    lDateCurrent = Val(Right$(sNow, 4) + Mid$(sNow, 4, 2) + Left$(sNow, 2))
    lDateBirthday = Val(Right$(sGebDat, 4) + Mid$(sGebDat, 4, 2) + Left$( _
      sGebDat, 2))
    iYears = Int(lDateCurrent - lDateBirthday)
    If iYears < 0 Then iYears = 0
 
    sTemp = Format$(iYears, "00000")
    While Len(sTemp) < 7: sTemp = " " + sTemp: Wend
    iYears = Val(Left$(sTemp, Len(sTemp) - 4))
    iMonth = Val(Mid$(sTemp, 4, 2))
    iDays = Val(Right$(sTemp, Len(sTemp) - 5))
  End If
 
  Alter = iYears
  Monate = iMonth
  Tage = iDays
End Function
 
Private Sub cmdStart_Click()
  ' Alter berechnen
  MsgBox "Alter: " & Alter(txtGebDat.Text) & " Jahre " & Monate & " Monate " & _
    Tage & " Tage"
End Sub

fg viperbone