Registriert seit: 28.04.2017
Version(en): 2010
11.08.2017, 10:02
(Dieser Beitrag wurde zuletzt bearbeitet: 12.08.2017, 09:41 von Rabe.
Bearbeitungsgrund: Betreff korrigiert: igniriert zu ignoriert
)
Und sowas zum Wochenende,
Guten Tag,
Ich weiß nicht was los ist, aber Excel Ignoriert die Speicher Baustein in meinem Code. Das hatte ich vorher mit der PW Abfrage und das Speichern ging, nun geht die PW Abfrage aber das speichern nicht mehr.
Ich verzweifel noch hier. Da es in der UF1 und UF2 nicht mehr geht und ich keine Ahnung haben warum, in einer anderen Tabelle geht es nach wie vor.
Code: Private Sub CommandButton1_Click()
'Passwortabfrage aus Tabbelle ("Passwörter")
Zeile = 1
gefunden = False
txtsuche = ""
Do While Worksheets("Passwörter").Cells(Zeile, 1) <> ""
If Worksheets("Passwörter").Cells(Zeile, 2) = txt_passwort.Text Then
txtsuche = Worksheets("Passwörter").Cells(Zeile, 1)
gefunden = True
End If
Zeile = Zeile + 1
Loop
If gefunden Then
Zeile = 2
Do While Worksheets("protokoll").Cells(Zeile, 1) <> ""
Zeile = Zeile + 1
Loop
Worksheets("protokoll").Cells(Zeile, 1) = txt_nachname
Worksheets("protokoll").Cells(Zeile, 2) = Now()
Dim lZeile As Long
'Wenn kein Datensatz in der ListBox1 markiert wurde, wird die Routine beendet
If ListBox1.ListIndex = -1 Then Exit Sub
'Ich muss prüfen, ob die ID Spalte auch gefüllt ist!!
If Trim(CStr(txt_nachname.Text)) = "" Then
'Meldung ausgeben
MsgBox "Sie müssen mindestens einen Namen eingeben!", vbCritical + vbOKOnly, "FEHLER!"
'Abbrechen der Speicherroutine
Exit Sub
End If
'AB HIER FÄNGT ER AN DEN TEIL ZU ÜBERSPRIGEN
-------------------------------------------------------------------------------------------------------------
'Zum Speichern benötigen wir die Zeilennummer des ausgewählten Datensatzes
lZeile = 2 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der zweiten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Worksheets("usernamen").Cells(lZeile, 2).Value)) <> ""
'Datensatz ID Spalte mit selektiertem Eintrag der ListBox vergleichen
If ListBox1.Text = Trim(CStr(Worksheets("usernamen").Cells(lZeile, 2).Value)) Then
'Eintrag gefunden, TextBoxen in die Zellen schreiben
Worksheets("usernamen").Cells(lZeile, 2).Value = Trim(CStr(txt_nachname.Text))
Worksheets("usernamen").Cells(lZeile, 3).Value = Trim(CStr(txt_vorname.Text))
Worksheets("usernamen").Cells(lZeile, 4).Value = txt_DG.Text
Worksheets("usernamen").Cells(lZeile, 5).Value = txt_datum.Text
'UND AB HIER STEIGT ER WIEDER EIN
------------------------------------------------------------------------------------------------------------
'Die ListBox muss nun neu geladen werden
'allerdings nur, wenn sich der txt_Nachname (ID) geändert hat
If ListBox1.Text <> Trim(CStr(txt_nachname.Text)) Then
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
Else
MsgBox "Falsches PW"
End If
End Sub
=wenn(a1="keine Ahnung";B1="mal nachdenken";C1="zu blöd ich frag das Forum")
Registriert seit: 12.10.2014
Version(en): 365 Insider (32 Bit)
Moin!
Vielleicht solltest Du die Datei noch kurz vor dem Wochenende hochladen.
Natürlich anonymisiert und ungeschützt.
By the way:
Dein Code ist mit den Do While-Schleifen etwas anachronistisch, hat aber nix mit Deinem Problem zu tun.
Gruß Ralf
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag.
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
Registriert seit: 25.04.2016
Version(en): 2013
11.08.2017, 10:25
(Dieser Beitrag wurde zuletzt bearbeitet: 11.08.2017, 10:26 von Storax.)
(11.08.2017, 10:13)RPP63 schrieb: By the way:
Dein Code ist mit den Do While-Schleifen etwas anachronistisch, hat aber nix mit Deinem Problem zu tun. Warum ist Do-While (genauer Do Loop) anachronistisch, oder meinst Du, wie das hier angewendet wird?
Do-While Syntax ist doch korrekt eingehalten und wird aktuell so verwendet
Code: Do { While | Until } condition
[ statements ]
[ Continue Do ]
[ statements ]
[ Exit Do ]
[ statements ]
Loop
-or-
Do
[ statements ]
[ Continue Do ]
[ statements ]
[ Exit Do ]
[ statements ]
Loop { While | Until } condition
Ich würde eher While Wend als anachronistisch bezeichnen
Registriert seit: 12.10.2014
Version(en): 365 Insider (32 Bit)
So etwas matche ich, ganz ohne Schleife, Storax.
Ich schrieb auch nur von einem Anachronismus, nicht von einem Fehler.
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag.
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
Registriert seit: 28.04.2017
Version(en): 2010
Danke für die schnellen Antworten,
ich bin kein Fachmann, weiß nur das, was ich aus copy paste haben und mir dadurch einiges an Wissen in den letzten Monaten zusammen getragen habe.
Daher keine Ahnung was ihr meint XD Sorry :D:D
Aber das mit dem Hochladen wird schwer. Es sind einige Verknüpfungen drin und da es eine Eingabemaske mit Benutzerprofilen sein soll, sind allerlei Passwörter schon eingefügt die alle raus zunehmen würde lange dauern.
Grundsätzlich speichert auch auch, was er nicht tut ist die Termin Eingabe.
txt_Nachname
txt_Vorname
txt_Dg
wird gespeichert ( btw soll es gar nicht daher haben ich es auch gelöscht, da diese Infos über eine Verlinkung kommt )
aber
Txt_Termin ( alter code txt_Datum ) wird beim drücken auf Com 1 gelöscht und verschwindet im Nirvana. Die userform will das Datum einfach nicht speichern.
Das ist der komplette Code zu UserForm1 ( ich habe paar wirklich uninteressante Dinge gelöscht )
Code: Private Sub com_speichern_Click()
'Passwortabfrage aus Tabbelle ("Passwörter")
Zeile = 1
gefunden = False
txtsuche = ""
Do While Worksheets("Passwörter").Cells(Zeile, 1) <> ""
If Worksheets("Passwörter").Cells(Zeile, 2) = txt_Passwort.Text Then
txtsuche = Worksheets("Passwörter").Cells(Zeile, 1)
gefunden = True
End If
Zeile = Zeile + 1
Loop
If gefunden Then
Zeile = 2
Do While Worksheets("protokoll").Cells(Zeile, 1) <> ""
Zeile = Zeile + 1
Loop
Worksheets("protokoll").Cells(Zeile, 1) = txt_Nachname
Worksheets("protokoll").Cells(Zeile, 2) = Now()
Dim lZeile As Long
'Wenn kein Datensatz in der ListBox1 markiert wurde, wird die Routine beendet
If ListBox1.ListIndex = -1 Then Exit Sub
'Ich muss prüfen, ob die ID Spalte auch gefüllt ist!!
If Trim(CStr(txt_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 = 2 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der zweiten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Worksheets("usernamen").Cells(lZeile, 2).Value)) <> ""
'Datensatz ID Spalte mit selektiertem Eintrag der ListBox vergleichen
If ListBox1.Text = Trim(CStr(Worksheets("usernamen").Cells(lZeile, 2).Value)) Then
'Eintrag gefunden, TextBoxen in die Zellen schreiben
Worksheets("usernamen").Cells(lZeile, 5).Value = txt_termin.Text
'Die ListBox muss nun neu geladen werden
'allerdings nur, wenn sich der txt_Nachname (ID) geändert hat
If ListBox1.Text <> Trim(CStr(txt_Nachname.Text)) Then
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
Else
MsgBox "Falsches PW"
End If
End Sub
_________________________________________________________________________________________________________________
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.
'Wir löschen standardmäßig alle bisherigen TextBoxen-Inhalte
txt_Nachname = ""
txt_Vorname = ""
txt_DG = ""
txt_termin = ""
'Nur wenn ein Eintrag selektiert/markiert ist
If ListBox1.ListIndex >= 0 Then
lZeile = 2 '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(Worksheets("usernamen").Cells(lZeile, 2).Value)) <> ""
'Wenn wir den Namen aus der ListBox1 in der Tabelle1 Spalte 2
'gefunden haben, übertragen wir die anderen Spalteninhalte
'in die TextBoxen!
If ListBox1.Text = Trim(CStr(Worksheets("usernamen").Cells(lZeile, 2).Value)) Then
'TextBoxen füllen
txt_Nachname = ListBox1.List(ListBox1.ListIndex, 0)
txt_Vorname = ListBox1.List(ListBox1.ListIndex, 1)
txt_DG = Worksheets("usernamen").Cells(lZeile, 4).Value
txt_termin = Worksheets("usernamen").Cells(lZeile, 5).Value
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 txt_termin_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If IsDate(Me.txt_termin) Then
Me.txt_termin = Format(Me.txt_termin, "MM DD YYYY")
ElseIf Me.txt_termin <> vbNullString Then
Beep
Cancel = True
End If
End Sub
_________________________________________________________________________________________________________________
Private Sub txtSuche_Change()
Dim i As Integer, ii As Integer
Dim vntList, strTxt As String, arrSelected()
strTxt = LCase(txtsuche)
vntList = ListBox1.List
ReDim arrSelected(ListBox1.ListCount - 1)
For i = 0 To ListBox1.ListCount - 1
For ii = 0 To ListBox1.ColumnCount - 1
arrSelected(i) = InStr(LCase(vntList(i, ii)), strTxt) > 0
If arrSelected(i) Then Exit For
Next
Next
With ListBox1
For i = 0 To .ListCount - 1
.Selected(i) = arrSelected(i)
Next
End With
End Sub
_________________________________________________________________________________________________________________
Private Sub UserForm_Initialize()
Dim lZeile As Long
'Wir löschen standardmäßig alle bisherigen TextBoxen-Inhalte
txt_Nachname = ""
txt_Vorname = ""
txt_DG = ""
txt_termin = ""
'In dieser Routine laden wir alle vorhandenen
'Einträge in die ListBox1
ListBox1.Clear 'Zuerst einmal die Liste leeren
lZeile = 2 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der zweiten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Worksheets("usernamen").Cells(lZeile, 2).Value)) <> ""
'Aktuelle Zeile in die ListBox eintragen
ListBox1.AddItem
ListBox1.List(ListBox1.ListCount - 1, 0) = Worksheets("usernamen").Cells(lZeile, 2).Text
ListBox1.List(ListBox1.ListCount - 1, 1) = Worksheets("usernamen").Cells(lZeile, 3).Text
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End Sub
_________________________________________________________________________________________________________________
=wenn(a1="keine Ahnung";B1="mal nachdenken";C1="zu blöd ich frag das Forum")
Registriert seit: 25.04.2016
Version(en): 2013
(11.08.2017, 10:29)RPP63 schrieb: So etwas matche ich, ganz ohne Schleife, Storax.
Ich schrieb auch nur von einem Anachronismus, nicht von einem Fehler.
Klar, da hast Du Recht, man braucht keine Schleife.
Dann hatte ich das mißverstanden.
Registriert seit: 11.04.2014
Version(en): Office 2007
Hallo,
(11.08.2017, 10:34)Kaywarri124 schrieb: Grundsätzlich speichert auch auch, was er nicht tut ist die Termin Eingabe.
txt_Nachname
txt_Vorname
txt_Dg
wird gespeichert ( btw soll es gar nicht daher haben ich es auch gelöscht, da diese Infos über eine Verlinkung kommt )
aber
Txt_Termin ( alter code txt_Datum ) wird beim drücken auf Com 1 gelöscht und verschwindet im Nirvana. Die userform will das Datum einfach nicht speichern.
Setze vor einer Codezeile mit txt_termin einen Haltepunkt.
Gruß Stefan
Win 10 / Office 2016
Registriert seit: 28.04.2017
Version(en): 2010
Guten Tag, Allen einen guten Start in die Woche.
Danke für die Antworten.
Ich habe das mit den Haltepunkten gemacht und habe gesehen das txt_Termin immer "" ist.
Naja ich habe mal die PW Abfrage ausgeklammert und siehe da, es liegt an der PW Abfrage.
Code: Zeile = 1
gefunden = False
txtsuche = ""
Do While Worksheets("Passwörter").Cells(Zeile, 1) <> ""
If Worksheets("Passwörter").Cells(Zeile, 2) = txt_Passwort.Text Then
txtsuche = Worksheets("Passwörter").Cells(Zeile, 1)
gefunden = True
End If
Zeile = Zeile + 1
Loop
If gefunden Then
Zeile = 2
Do While Worksheets("protokoll").Cells(Zeile, 1) <> ""
Zeile = Zeile + 1
Loop
Worksheets("protokoll").Cells(Zeile, 1) = txt_Nachname
Worksheets("protokoll").Cells(Zeile, 2) = Now()
'hier kommt dann der Speicher Code
=wenn(a1="keine Ahnung";B1="mal nachdenken";C1="zu blöd ich frag das Forum")
Registriert seit: 28.04.2017
Version(en): 2010
Danke nochmal, echt immer wieder gute Hilfe,
habe das Problem gelöst.
Er fragt nach Benutzername und Passwort und speichert dann die Eingabe
Code: 'Passwortabfrage aus Tabbelle ("Passwörter")
zeile = 2
gefunden = False
Do While Worksheets("Passwörter").Cells(zeile, 1) <> ""
If Worksheets("Passwörter").Cells(zeile, 1) = txtsuche.Text Then
If Worksheets("Passwörter").Cells(zeile, 2) = txt_Passwort.Text Then
gefunden = True
End If
End If
zeile = zeile + 1
Loop
If gefunden Then
zeile = 2
Do While Worksheets("protokoll").Cells(zeile, 1) <> ""
zeile = zeile + 1
Loop
Worksheets("protokoll").Cells(zeile, 1) = txt_Nachname
Worksheets("protokoll").Cells(zeile, 2) = Now()
Dim lZeile As Long
'Wenn kein Datensatz in der ListBox1 markiert wurde, wird die Routine beendet
If ListBox1.ListIndex = -1 Then Exit Sub
'Ich muss prüfen, ob die ID Spalte auch gefüllt ist!!
If Trim(CStr(txt_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 = 2 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der zweiten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Worksheets("usernamen").Cells(lZeile, 2).Value)) <> ""
'Datensatz ID Spalte mit selektiertem Eintrag der ListBox vergleichen
If ListBox1.Text = Trim(CStr(Worksheets("usernamen").Cells(lZeile, 2).Value)) Then
'Eintrag gefunden, TextBoxen in die Zellen schreiben
Worksheets("usernamen").Cells(lZeile, 5).Value = txt_termin.Text
'Die ListBox muss nun neu geladen werden
'allerdings nur, wenn sich der txt_Nachname (ID) geändert hat
If ListBox1.Text <> Trim(CStr(txt_Nachname.Text)) Then
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
Else
MsgBox "Keine Übereinstimmung Nachname mit Passwort. Bitte wiederholen sie ihre Eingabe. Wenn sie noch kein Passwort haben gehen sie auf Passwort Anfrage melden sie sich beim Admin unter App.: 6513"
End If
End Sub
=wenn(a1="keine Ahnung";B1="mal nachdenken";C1="zu blöd ich frag das Forum")
|
