Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
892to896
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
892to896
892to896
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Alter & Altersklasse in Userform errechnen

Alter & Altersklasse in Userform errechnen
31.07.2007 08:53:06
Frank
Hallo!
Ich möchte meine Userform etwas verbessern. Aktuell habe ich ein eine Textbox, in die ich das Geburtsdatum eingeben. Weiterhin eine Kombo-Box, in der ich die Altersklasse auswähle.
Perfekt wäre, wenn das aktuelle Alter in einem weiteren Textfeld errechnet werden würde und die Kombo-Box alleine die entsprechende Altersstufe sucht.
Einige Infos:
Das Geburtsdatum wird in TextBox4, die Altersstufe in ComboBox1 eingegeben.
Die Altersstufen sucht die ComboBox aus der Tabelle "Info". Hier stehen in Stalte G bis I die Stufen und die Grenzen der Stufe.
Altersklasse von bis
K1 6 11
K2 12 13
J1 14 15
J2 16 19
S1 20 39
S2 40 59
S3 60 99
Kann mir jemand bei dem Code helfen?
Gruß Frank

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Alter & Altersklasse in Userform errechnen
31.07.2007 09:06:00
Armin
Hallo Frank,
der Aufwand das alles nachzustellen ist sehr zeitintensiv. Kannst Du nicht ein Beispiel hoch laden?
Gruß Armin

AW: Alter & Altersklasse in Userform errechnen
31.07.2007 09:15:00
Frank
Leider ist die Datei zu groß für dem Upload (1400KB). Als Zip immernoch 540KB. Da macht der Server nicht mit. Sonst gerne.
Gruß Frank

AW: Alter & Altersklasse in Userform errechnen
31.07.2007 09:46:00
Frank
Ich könnte die Datei per Mail schicken, fals das hilft.

AW: kleine Korrektur
31.07.2007 10:59:00
Peter
Hallo Frank,
es fehlte der 1. Eintrag in der ComboBox. https://www.herber.de/bbs/user/44605.xls
Gruß Peter

Anzeige
AW: kleine Korrektur
31.07.2007 12:19:00
Frank
Hallo!
Zum Teil funktioniert die Sache bereits. Leider habe ich etwas Probleme den Code in den bestehenden einzufügen. Außerdem ist die Altersberechnung noch nicht korrekt. Beispielsweise ist jemand, der am 05.08.1977 gebroren wurde nach diesem Code bereits 30. Die Angabe müsste leider auf den Tag genau sein.
Hier der gesamte Code:
Option Explicit
Dim rngFind As Range
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal _
lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex _
As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex _
As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal _
hwnd As Long) As Long
Private Const GWL_STYLE As Long = -16
Private Const WS_SYSMENU As Long = &H80000
Private hWndForm As Long
Private bCloseBtn As Boolean

Private Sub CommandButton3_ändern_Click()
Sheets("Daten").Select
ActiveSheet.Unprotect Password:="dolphin"
'Neuen Datensatz anlegen
Dim letzte_Zeile As Long
With Worksheets("Daten")
'Die letzte beschrieben Zeile in Spalte A ermitteln
letzte_Zeile = .Range("A65536").End(xlUp).Offset(1, 0).Row
.Cells(letzte_Zeile, 1) = TextBox1.Text 'ID
.Cells(letzte_Zeile, 2) = TextBox2.Text 'Nachname
.Cells(letzte_Zeile, 3) = TextBox3.Text 'Vorname
.Cells(letzte_Zeile, 8) = TextBox4.Text 'Geburtsdatum
.Cells(letzte_Zeile, 5) = TextBox5.Text 'Adresse
.Cells(letzte_Zeile, 6) = TextBox6.Text 'PLZ
.Cells(letzte_Zeile, 7) = TextBox7.Text 'Ort
.Cells(letzte_Zeile, 4) = TextBox8.Text 'beschäftigt seit
.Cells(letzte_Zeile, 9) = TextBox9.Text 'Telefon
.Cells(letzte_Zeile, 10) = TextBox10.Text 'Mobil
.Cells(letzte_Zeile, 11) = TextBox11.Text 'E-MAil
.Cells(letzte_Zeile, 19) = TextBox12.Text 'eingearbeitet FS
.Cells(letzte_Zeile, 20) = TextBox13.Text 'eingearbeitet Bar
.Cells(letzte_Zeile, 21) = TextBox14.Text 'Konfektionsgröße
.Cells(letzte_Zeile, 22) = TextBox15.Text 'VS Tauglich
.Cells(letzte_Zeile, 25) = TextBox16.Text 'Wochenstunden
.Cells(letzte_Zeile, 26) = TextBox17.Text 'Kostenstelle
.Cells(letzte_Zeile, 27) = TextBox18.Text 'Stunden pro Monat
.Cells(letzte_Zeile, 28) = TextBox19.Text 'Überstunden
.Cells(letzte_Zeile, 24) = TextBox20.Text 'Bermerkungen
.Cells(letzte_Zeile, 12) = ComboBox1.Text 'Bereich 1
.Cells(letzte_Zeile, 13) = ComboBox2.Text 'Bereich 2
.Cells(letzte_Zeile, 14) = ComboBox3.Text 'Bereich 3
.Cells(letzte_Zeile, 15) = ComboBox5.Text 'Sprache 1
.Cells(letzte_Zeile, 16) = ComboBox6.Text 'Sprache 2
.Cells(letzte_Zeile, 17) = ComboBox7.Text 'Sprache 3
.Cells(letzte_Zeile, 18) = ComboBox8.Text 'Sprache 4
End With
ClearAll
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=" _
dolphin"
ActiveSheet.EnableSelection = xlUnlockedCells
Unload grüne_Welle_1
Application.Run "UF_Show"
End Sub



Private Sub CommandButton3_Click()
Sheets("Daten").Select
ActiveSheet.Unprotect Password:="dolphin"
'Neuen Datensatz anlegen
Dim letzte_Zeile As Long
With Worksheets("Daten")
'Die letzte beschrieben Zeile in Spalte A ermitteln
letzte_Zeile = .Range("A65536").End(xlUp).Offset(1, 0).Row
.Cells(letzte_Zeile, 1) = TextBox1.Text 'ID
.Cells(letzte_Zeile, 2) = TextBox2.Text 'Nachname
.Cells(letzte_Zeile, 3) = TextBox3.Text 'Vorname
.Cells(letzte_Zeile, 8) = TextBox4.Text 'Geburtsdatum
.Cells(letzte_Zeile, 5) = TextBox5.Text 'Adresse
.Cells(letzte_Zeile, 6) = TextBox6.Text 'PLZ
.Cells(letzte_Zeile, 7) = TextBox7.Text 'Ort
.Cells(letzte_Zeile, 4) = TextBox8.Text 'beschäftigt seit
.Cells(letzte_Zeile, 9) = TextBox9.Text 'Telefon
.Cells(letzte_Zeile, 10) = TextBox10.Text 'Mobil
.Cells(letzte_Zeile, 11) = TextBox11.Text 'E-MAil
.Cells(letzte_Zeile, 19) = TextBox12.Text 'eingearbeitet FS
.Cells(letzte_Zeile, 20) = TextBox13.Text 'eingearbeitet Bar
.Cells(letzte_Zeile, 21) = TextBox14.Text 'Konfektionsgröße
.Cells(letzte_Zeile, 22) = TextBox15.Text 'VS Tauglich
.Cells(letzte_Zeile, 25) = TextBox16.Text 'Wochenstunden
.Cells(letzte_Zeile, 26) = TextBox17.Text 'Kostenstelle
.Cells(letzte_Zeile, 27) = TextBox18.Text 'Stunden pro Monat
.Cells(letzte_Zeile, 28) = TextBox19.Text 'Überstunden
.Cells(letzte_Zeile, 24) = TextBox20.Text 'Bermerkungen
.Cells(letzte_Zeile, 12) = ComboBox1.Text 'Bereich 1
.Cells(letzte_Zeile, 13) = ComboBox2.Text 'Bereich 2
.Cells(letzte_Zeile, 14) = ComboBox3.Text 'Bereich 3
.Cells(letzte_Zeile, 15) = ComboBox5.Text 'Sprache 1
.Cells(letzte_Zeile, 16) = ComboBox6.Text 'Sprache 2
.Cells(letzte_Zeile, 17) = ComboBox7.Text 'Sprache 3
.Cells(letzte_Zeile, 18) = ComboBox8.Text 'Sprache 4
End With
ClearAll
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=" _
dolphin"
ActiveSheet.EnableSelection = xlUnlockedCells
Unload grüne_Welle_1
End Sub



Private Sub CommandButton5_Click()
If TextBox1.Text = "" Then
Unload grüne_Welle_1
Exit Sub
Else
If MsgBox("Den angezeigten Datensatz speichern ?", 36, "Sicherheitsabfrage") = vbYes Then
CommandButton3_Click
End If
Unload grüne_Welle_1
End If
End Sub



Private Sub CommandButton4_Click()
Dim a As Integer
Dim msg
'Datensatz löschen
a = Range(rngFind.Address).Row
If MsgBox("    Datensatz wirklich löschen", vbYesNo) = vbNo Then
Exit Sub
Else
Rows(a).Delete
End If
ClearAll
TextBox1.SetFocus
End Sub



Private Sub CommandButton6_Click()
Sheets("Daten").Select
ActiveSheet.Unprotect Password:="dolphin"
Dim aStr As Byte
If TextBox1.Text = "" Then
ClearAll
TextBox1.SetFocus
Exit Sub
Else
aStr = MsgBox("     Möchten Sie den angezeigten Datensatz" & vbCrLf & vbCrLf & vbTab & _
"- vorher speichern (Ja)" & vbCrLf & vbCrLf & vbTab & _
"- nur leeren (Nein)" & vbCrLf & vbCrLf & vbTab & _
"- nicht unternehmen (Abbrechen)", vbYesNoCancel, "Sicherheitsabfrage")
If aStr = vbYes Then
CommandButton3_ändern_Click
ElseIf aStr = vbNo Then
ClearAll
Me.TextBox1 = WorksheetFunction.Max(Range("a:a")) + 1
Else
TextBox1.SetFocus
End If
TextBox1.SetFocus
End If
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=" _
dolphin"
ActiveSheet.EnableSelection = xlUnlockedCells
End Sub



Public Sub UserForm_Initialize()
If Val(Application.Version) >= 9 Then
hWndForm = FindWindow("ThunderDFrame", Me.Caption)
Else
hWndForm = FindWindow("ThunderXFrame", Me.Caption)
End If
bCloseBtn = False
SetUserFormStyle
ComboBox2.RowSource = "'Info'!B2:B9"
ComboBox3.RowSource = "'Info'!C2:C9"
ComboBox5.RowSource = "'Info'!E2:E9"
ComboBox6.RowSource = "'Info'!E2:E9"
ComboBox7.RowSource = "'Info'!E2:E9"
ComboBox8.RowSource = "'Info'!F2:F9"
Me.TextBox1 = WorksheetFunction.Max(Range("a:a")) + 1
End Sub



Private Sub SetUserFormStyle()
Dim frmStyle As Long
If hWndForm = 0 Then Exit Sub
frmStyle = GetWindowLong(hWndForm, GWL_STYLE)
If bCloseBtn Then
frmStyle = frmStyle Or WS_SYSMENU
Else
frmStyle = frmStyle And Not WS_SYSMENU
End If
SetWindowLong hWndForm, GWL_STYLE, frmStyle
DrawMenuBar hWndForm
End Sub



Private Sub optCloseOn_Click()
bCloseBtn = True
cmdBeenden.Cancel = True
SetUserFormStyle
End Sub



Private Sub optCloseOff_Click()
bCloseBtn = False
cmdBeenden.Cancel = False
SetUserFormStyle
End Sub


Sub ClearAll()
Dim C As Integer
On Error Resume Next
For C = 1 To 8
Me.Controls("ComboBox" & CStr(C)).Text = ""
Next C
For C = 1 To 20
Me.Controls("TextBox" & CStr(C)).Text = ""
Next C
Image2.Picture = LoadPicture("")
End Sub


...und hier die bisherige Überarbeitung der Altersberechnung.
Option Explicit


Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim iAlter  As Integer
Dim iLiBo   As Integer
If Me.TextBox4.Value  "" Then
If IsDate(Me.TextBox4.Value) Then
iAlter = Year(Date) - Year(CDate(TextBox4.Value))
Me.TextBox21.Value = iAlter
If iAlter  99 Then Exit Sub
For iLiBo = 0 To Me.ComboBox1.ListCount
If iAlter >= Me.ComboBox1.List(iLiBo, 1) And _
iAlter 


'
' Ich möchte mein UserForm(ular) etwas verbessern.
' Aktuell habe ich eine Textbox, in die ich das Geburtsdatum eingeben.
' Weiterhin eine ComboBox, in der ich die Altersklasse auswähle.
'
' Perfekt wäre es, wenn das aktuelle Alter in einem weiteren Textfeld errechnet
' werden würde und die ComboBox die entsprechende Altersstufe alleine sucht.
'
' Einige Infos:
'
' Das Geburtsdatum wird in TextBox4, die Altersstufe in ComboBox1 eingegeben.
' Die Altersstufen sucht die ComboBox aus der Tabelle "Info".
' Hier stehen in Stalte G bis I die Stufen und die Grenzen der Stufe.
'


Private Sub UserForm_Activate()
Dim lZeile  As Long
Dim lCoBox  As Long
With Worksheets("Alter")
With Me.ComboBox1
.ColumnCount = 3
.ColumnWidths = "1 cm; 1 cm; 1 cm"
For lZeile = 1 To Range("A65536").End(xlUp).Row
.AddItem " "
.List(lCoBox, 0) = Range("A" & lZeile).Value
.List(lCoBox, 1) = Range("B" & lZeile).Value
.List(lCoBox, 2) = Range("C" & lZeile).Value
lCoBox = lCoBox + 1
Next lZeile
End With
End With
Me.TextBox4.SetFocus
End Sub


Wie gesagt, ich habe etwas Probleme damit, die beide Codes zusammenzuführen. Entweder bekomme ich Fehler bei der Initianlisierung der Userform oder beim Speichern.
Gruß Frank

Anzeige
AW: kleine Korrektur
31.07.2007 12:56:14
Peter
Hallo Frank,
hier ist eine Version, die das Alter genau berechnet. https://www.herber.de/bbs/user/44617.xls
Wo du das Makro bei dir einfügen kannst, kann ich dir aus Zeitgründen nicht herausfinden.
Gruß Peter

AW: Alter & Altersklasse in Userform errechnen
31.07.2007 21:30:29
Frank
OK - Verstehe ich. Trotzdem danke fürs versuchen!

Ist diese Frage noch offen ? (owT)
01.08.2007 12:52:00
Renee

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige