02.05.2017, 14:27 (Dieser Beitrag wurde zuletzt bearbeitet: 02.05.2017, 15:06 von WillWissen.
Bearbeitungsgrund: Mikroschriftformatierung aufgehoben
)
Also danke für die Hilfe, ich versuch soviel zu schreiben wie nur geht. Die Datei senden kann ich nicht da es sich um eine Datei von der Arbeit handelt.
Wie kann ich verhindert das die TextBox das Datumsformat ändert. Und AfterUpdate und Exit habe ich gespostet damit man sehen kann was bis jetzt in den Textboxen Passiert.
Hier noch der code zur Userform
Private Sub UserForm_Activate() 'Wenn die Eingabemaske angezeigt wird, markieren wir den ersten Namen 'jedoch nur, wenn auch Einträge in der Liste stehen If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0 End Sub
'Startroutine, wird ausgeführt bevor die Eingabemaske angezeigt wird Private Sub UserForm_Initialize() Dim lZeile As Long
'In dieser Routine laden wir alle vorhandenen 'Einträge in die ListBox1 ListBox1.Clear 'Zuerst einmal die Liste leeren
lZeile = 7 'Start in Zeile 2, Zeile 1 sind ja die Überschriften 'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht Do While Trim(CStr(Tabelle1.Cells(lZeile, 2).Value)) <> ""
'Aktuelle Zeile in die ListBox eintragen ListBox1.AddItem Trim(CStr(Tabelle1.Cells(lZeile, 2).Value))
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
Ich bräuchte wohl etwas was das Format vorgibt wie die TextBox die Zelle z.B. J7 liest und darstellt
Private Sub Label29_Click() UserForm6.Show End Sub Private Sub ComboBox2_Change()
End Sub
'Neuer Eintrag Schaltfläche Ereignisroutine Private Sub CommandButton1_Click() Dim lZeile As Long 'Wenn der Benutzer einen neuen Eintrag erzeugen möchte, 'erstellen wir einen neuen Eintrag in der ListBox und markieren 'diesen, damit der Benutzer die Daten eintragen kann
lZeile = 7 'Start in Zeile 2, Zeile 1 sind ja die überschriftrn 'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht Do While Trim(CStr(Tabelle1.Cells(lZeile, 2).Value)) <> "" lZeile = lZeile + 1 'Nächste Zeile bearbeiten Loop
'Nach Durchlauf dieser Schleife steht lZeile in der ersten leeren Zeile von Tabelle1 'Neuen Eintrag in die Tabelle1 schreiben, Spalte ID muss gefüllt sein, damit 'unsere Routinen die Zeile wiederfinden! Tabelle1.Cells(lZeile, 2) = CStr("Neuer Eintrag Zeile " & lZeile)
'Und neuen Eintrag in die UserForm eintragen ListBox1.AddItem CStr("Neuer Eintrag Zeile " & lZeile)
'Den neuen Eintrag markieren mit Hilfe des ListIndexes ListBox1.ListIndex = ListBox1.ListCount - 1 'Durch das Click Ereignis der ListBox werden die Daten automatisch geladen
End Sub
'Löschen Schaltfläche Ereignisroutine Private Sub CommandButton2_Click() Dim lZeile As Long
'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet If ListBox1.ListIndex = -1 Then Exit Sub
'Zum Löschen benötigen wir die Zeilennummer des ausgewählten Datensatzes lZeile = 7 'Start in Zeile 2, Zeile 1 sind ja die Überschriften 'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht Do While Trim(CStr(Tabelle1.Cells(lZeile, 2).Value)) <> ""
'Datensatz ID Spalte mit selektiertem Eintrag der ListBox vergleichen If ListBox1.Text = Trim(CStr(Tabelle1.Cells(lZeile, 2).Value)) Then
'Eintrag gefunden, die ganze Zeile wird nun gelöscht Tabelle1.Rows(CStr(lZeile & ":" & lZeile)).Delete
'Die ListBox muss nun neu geladen werden! Call UserForm_Initialize If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
'Speichern Schaltfläche Ereignisroutine Private Sub CommandButton3_Click() Dim lZeile As Long
'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet If ListBox1.ListIndex = -1 Then Exit Sub
'Wir müssen prüfen, ob die ID Spalte auch gefüllt ist!! If Trim(CStr(Nachname.Text)) = "" Then 'Meldung ausgeben MsgBox "Sie müssen mindestens einen Namen eingeben!", vbCritical + vbOKOnly, "FEHLER!" 'Abbrechen der Speicherroutine Exit Sub End If 'Ausbauoption: Prüfen, ob die ID in Tabelle1 Spalte 1 schon vorhanden ist!
'Zum Speichern benötigen wir die Zeilennummer des ausgewählten Datensatzes lZeile = 7 'Start in Zeile 7, Zeile 6 sind ja die Überschriften 'Schleife solange etwas in der zweiten Spalte in Tabelle 1 drin steht Do While Trim(CStr(Tabelle1.Cells(lZeile, 2).Value)) <> "" ActiveSheet.Unprotect Password:="qwe"
'Datensatz ID Spalte mit selektiertem Eintrag der ListBox vergleichen If ListBox1.Text = Trim(CStr(Tabelle1.Cells(lZeile, 2).Value)) Then
'Die ListBox muss nun neu geladen werden 'allerdings nur, wenn sich der Nachname (ID) geändert hat If ListBox1.Text <> Trim(CStr(Nachname.Text)) Then Call UserForm_Initialize If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0 End If
Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
End If
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop 'Dein Code ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True ActiveSheet.Protect Password:="qwe", userinterfaceonly:=True ActiveSheet.EnableAutoFilter = True End Sub
'Beenden Schaltfläche Ereignisroutine Private Sub CommandButton4_Click() Unload Me End Sub
Private Sub Image1_Click()
End Sub
Private Sub CommandButton5_Click() Call Lf_Nr_Sort End Sub
Private Sub CommandButton6_Click() Untersuchungsunterlagen End Sub
Private Sub G46_AfterUpdate() If IsDate(G46) Then G46 = Format(G46, "MMM.YY") End Sub
Private Sub G46_Exit(ByVal Cancel As MSForms.ReturnBoolean) If Not IsDate(G46) Then G46 = "" Cancel = True End If End Sub
Private Sub Label1_Click()
End Sub
Private Sub Label16_Click()
End Sub
Private Sub Label19_Click()
End Sub
Private Sub Label23_Click()
End Sub
Private Sub Label24_Click()
End Sub
Private Sub Label25_Click()
End Sub
Private Sub Label28_Click()
End Sub
Private Sub Label4_Click()
End Sub
Private Sub Label5_Click()
End Sub
Private Sub Label9_Click()
End Sub
Private Sub LaufendeNummer_Change()
End Sub
'Klick auf die ListBox Ereignisroutine Private Sub ListBox1_Click() Dim lZeile As Long 'Wenn der Benutzer einen Namen anklickt, suchen wir 'diesen in der Tabelle1 heraus und tragen die Daten 'in die TextBoxen ein.
'Nur wenn ein Eintrag selektiert/markiert ist If ListBox1.ListIndex >= 0 Then
lZeile = 7 'Start in Zeile 2, Zeile 1 sind ja die Überschriften 'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht Do While Trim(CStr(Tabelle1.Cells(lZeile, 2).Value)) <> ""
'Wenn wir den Namen aus der ListBox1 in der Tabelle1 Spalte 1 'gefunden haben, übertragen wir die anderen Spalteninhalte 'in die TextBoxen! If ListBox1.Text = Trim(CStr(Tabelle1.Cells(lZeile, 2).Value)) Then
Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
End If
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End If
End Sub
Private Sub Nachname_Change()
End Sub
Private Sub nächster_termin_Change()
End Sub
Private Sub G46_Change()
End Sub
Private Sub TextBox10_AfterUpdate() If IsDate(TextBox10) Then TextBox10 = Format(TextBox10, "MMM YYYY") End Sub
Private Sub TextBox10_Change()
End Sub
Private Sub TextBox10_Exit(ByVal Cancel As MSForms.ReturnBoolean) If Not IsDate(TextBox10) Then TextBox10 = "" Cancel = True End If End Sub
Private Sub TextBox11_AfterUpdate() If IsDate(TextBox11) Then TextBox11 = Format(TextBox11, "MMM YYYY") End Sub
Private Sub TextBox11_Change()
End Sub
Private Sub TextBox11_Exit(ByVal Cancel As MSForms.ReturnBoolean) If Not IsDate(TextBox11) Then TextBox11 = "" Cancel = True End If End Sub
Private Sub TextBox12_AfterUpdate() If IsDate(TextBox12) Then TextBox12 = Format(TextBox12, "MMM YYYY") End Sub
Private Sub TextBox12_Change()
End Sub
Private Sub TextBox12_Exit(ByVal Cancel As MSForms.ReturnBoolean) If Not IsDate(TextBox12) Then TextBox12 = "" Cancel = True End If End Sub
Private Sub TextBox13_AfterUpdate() If IsDate(TextBox13) Then TextBox13 = Format(TextBox13, "MMM.YY") End Sub
Private Sub TextBox13_Change()
End Sub
Private Sub TextBox13_Exit(ByVal Cancel As MSForms.ReturnBoolean) If Not IsDate(TextBox13) Then TextBox13 = "" Cancel = True End If End Sub
Private Sub TextBox14_AfterUpdate() If IsDate(TextBox14) Then TextBox14 = Format(TextBox14, "MMM YYYY") End Sub
Private Sub TextBox14_Change()
End Sub
Private Sub TextBox14_Exit(ByVal Cancel As MSForms.ReturnBoolean) If Not IsDate(TextBox14) Then TextBox14 = "" Cancel = True End If End Sub
Private Sub TextBox15_AfterUpdate() If IsDate(TextBox15) Then TextBox15 = Format(TextBox15, "MMM YYYY") End Sub
Private Sub TextBox15_Change()
End Sub
Private Sub TextBox15_Exit(ByVal Cancel As MSForms.ReturnBoolean) If Not IsDate(TextBox15) Then TextBox15 = "" Cancel = True End If End Sub
Private Sub TextBox16_AfterUpdate() If IsDate(TextBox16) Then TextBox16 = Format(TextBox16, "MMM YYYY") End Sub
Private Sub TextBox16_Change()
End Sub
Private Sub TextBox16_Exit(ByVal Cancel As MSForms.ReturnBoolean) If Not IsDate(TextBox16) Then TextBox16 = "" Cancel = True End If End Sub
Private Sub TextBox17_AfterUpdate() If IsDate(TextBox17) Then TextBox17 = Format(TextBox17, "MMM YYYY") End Sub
Private Sub TextBox17_Change()
End Sub
Private Sub TextBox17_Exit(ByVal Cancel As MSForms.ReturnBoolean) If Not IsDate(TextBox17) Then TextBox17 = "" Cancel = True End If End Sub
Private Sub TextBox18_AfterUpdate() If IsDate(TextBox18) Then TextBox18 = Format(TextBox18, "MMM YYYY") End Sub
Private Sub TextBox18_Change()
End Sub
Private Sub TextBox18_Exit(ByVal Cancel As MSForms.ReturnBoolean) If Not IsDate(TextBox18) Then TextBox18 = "" Cancel = True End If End Sub
Private Sub TextBox19_Change() For Zeilennummer = 7 To Range("B300").End(xlUp).Row
If TextBox19.Text = Cells(Zeilennummer, 2) Then ListBox1.ListIndex = Zeilennummer - 7 End If
If TextBox19.Text = Cells(Zeilennummer, 7) Then ListBox1.ListIndex = Zeilennummer - 7 End If
If TextBox19.Text = Cells(Zeilennummer, 3) Then ListBox1.ListIndex = Zeilennummer - 7 End If
Next End Sub
Private Sub TextBox5_Change()
End Sub
Private Sub ComboBox1_Change()
End Sub
Private Sub TextBox9_AfterUpdate()
If IsDate(Me.TextBox9.Value) Then ActiveSheet.Cells(ActiveCell.Row, 4).Value = CDate(Me.TextBox9.Value) ActiveSheet.Cells(ActiveCell.Row, 4).NumberFormat = "MM YYYY" End If
End Sub
Private Sub TextBox9_Exit(ByVal Cancel As MSForms.ReturnBoolean) If IsDate(TextBox9.Text) Then TextBox9.Text = Format(TextBox9.Text, "MMM YYYY") Else TextBox9.Text = "Kein gültiges Datum!" Cancel = True End If End Sub
Private Sub TextBox9_Change()
End Sub
Private Sub Vorname_Change()
End Sub
Private Sub ComboBox4_Change()
End Sub
Private Sub UserForm_Activate() 'Wenn die Eingabemaske angezeigt wird, markieren wir den ersten Namen 'jedoch nur, wenn auch Einträge in der Liste stehen If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0 End Sub
'Startroutine, wird ausgeführt bevor die Eingabemaske angezeigt wird Private Sub UserForm_Initialize()
'In dieser Routine laden wir alle vorhandenen 'Einträge in die ListBox1 ListBox1.Clear 'Zuerst einmal die Liste leeren
lZeile = 7 'Start in Zeile 2, Zeile 1 sind ja die Überschriften 'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht Do While Trim(CStr(Tabelle1.Cells(lZeile, 2).Value)) <> ""
'Aktuelle Zeile in die ListBox eintragen ListBox1.AddItem Trim(CStr(Tabelle1.Cells(lZeile, 2).Value))
Ich habe das im Netzt gefunden um die TextBox umzuwandeln
If isdate(me.TextBox9.Value) Then ActiveSheet.Cells(ActiveCell.Row, 4).Value = CDate(MeTextBox9.Value) ActiveSheet.Cells(ActiveCell.Row, 4).NumberFormat = "MMM YYYY" End if
(02.05.2017, 14:27)Kaywarri124 schrieb: Die Datei senden kann ich nicht da es sich um eine Datei von der Arbeit handelt.
Du kannst aber diese Datei entschlacken und die Daten anonymisieren, dann ist nichts mehr 'von Arbeit'. Zum Test reicht auch ein Beispieldatensatz mit Max Mustermann oder was auch immer.
Ansonsten musst Du halt auf jemand warten der Lust hat 'die Kiste' nachzubauen.
Zur Selbsthilfe: Schau mal in die Routine Listbox1_Click rein, darin werden den (genial benamsten) Textboxen die Werte zugewiesen. Da musst Du eingreifen.
So ich habe die Datei mal angehangen und so geleert das ich sie Öffentlich machen kann.
Zu Erklärung was nochmal mein Problem ist.
1. Sorry für die unordentliche VBA das meine erste umfangreiche Excel daher ist sie etwas durcheinander 2. Wenn ich auf "Datenbank" drücke öffnet sich die UserForm1. In der TextBox9 "G20" steht ein Datum, drücke ich jetzt auf Speichern, weil ich zum Beispiel den Status änder ( Daten Fehlen mit absicht da nicht wichtig für das Problem ) dann ändert sich das Datum in "J7" und somit erkennt die Berechnung in "J3:J5" nicht mehr das Datum. 3. Wenn ich aber bevor ich speicher in die TextBox klicke, dann geht es schon. Jedoch stehen da teilweise 8 Daten und das bei 300 MItarbeitern wird das etwas mühselig jedesmal auf alle Daten zu drücken bevor ich Speicher. 4. Wie kann ich verhindern das ich einen "Fehler" bekomme ( UserForm hängt sich auf ), wenn mal eine TextBox leer bleibt ich aber durch Tape, weil ich in G20 was reinschreibe und dann in G46 z.B.
ich bin neue im Thread, konnte mir die Beispieldatei aber leider nicht ansehen weil ich ein Fehlermeldung wegen defekte AktiveSteuerelemente in Zeile 2 Spalte 179 und Spalte 210 bekomme. Die "ddl" Bibliothek ist beschaedigt und kennt den Befehl Trim(Cstr) nicht mehr! UserForm wird nicht initalisiert.
Kannst du die Beispieldatei bitte überprüfen und ggf. eine neue hochladen.
03.05.2017, 02:10 (Dieser Beitrag wurde zuletzt bearbeitet: 03.05.2017, 02:51 von DbSam.)
Hallo return,
die Datei geht schon, wahrscheinlich hat das Excel von Gast schon Feierabend ...
Anbei das Testfile zurück. Änderungen wurden beispielhaft an der 'Textbox9' vollzogen. So nebenbei heißt diese jetzt auch 'txtG20' - also etwas passender zum Inhalt der Box.
Bei dieser Textbox habe ich zur Demo die gewünschten Anforderungen eingebaut. Du kannst also nach 'txtG20' suchen und Dir alles anschauen. So in etwa könnte das gelöst werden ...
Dein Punkt 4 erledigt sich durch das Anpassen des Codes der betroffenen Controls an den von 'txtG20'
Ansonsten: Der gesamte Code und das komplette Sheet benötigen von Anfang bis Ende dringend 'heilende Hände'. (Die Optik sicherlich auch, aber das ist Ansichtssache und nicht das Thema.)
Da liegt noch einiges im Argen, man(Du) sollte aber erst einmal den vorhandenen Code aufräumen. Ich mag nicht. Angesichts der Uhrzeit lege ich für heute das Handwerk nieder.
btw.: Der Text 'Angestellter' im Form bedarf dringend einer Rechtschreibprüfung. ;)
Gruß Carsten
PS: Dann ist mir noch etwas anderes aufgefallen, aber ... Naja :D
Folgende(r) 1 Nutzer sagt Danke an DbSam für diesen Beitrag:1 Nutzer sagt Danke an DbSam für diesen Beitrag 28 • Kaywarri124
So ich bin hin und weg :D habe jetzt alles schön aufgeräumt und auch die Namen der TextBoxen usw. geändert. Es klappt ja besser als gedacht. Vielen vielen dank!!
![[-]](https://www.clever-excel-forum.de/images/collapse.png)
