AW: VBA Codierung drei Probleme-Userform
24.06.2018 17:51:56
fcs
Hallo Markus,
hier deine Datei mit allen Anpassungen in den Userformen.
https://www.herber.de/bbs/user/122278.xlsm
Die eingebauten Anpassung hab im Blatt "MASKE" in Textboxen eingetragen
ja das mit den Cdec habe ich dann heute auch mal schmerzlich feststellen müssen. :-D
Das kann man mit einem Makro steuern, das den Inhalt des Steuerelements(z.B. Textbox ) prüft und in die gewünschte Zelle einträgt - siehe hochgeladene Datei bzw. Beispiel unten.
Leider kenne ich mich mit den Funktionen Modul und Klasse noch gar nicht aus, ich habe schon einige Dateien gesehen aber das ist dann auch das höchste der Gefühle.
Ich arbeite da auch nicht täglich mit, aber bei riesigen Mengen an ähnlichen Steuerelementen, kann man schon einiges an Code einsparen und ich prüfe nochmals in deiner Datei was möglich ist.
Ich habe heute ein weiteres Problem festgestellt, und zwar, bei der Poststelle hat das mit dem Übertragen in die nächste freie Zeile wunderbar geklappt, nun ist der gleiche Code in der Arbeitsvorbereitung und hier wird die gleiche Zeile immer wieder überschrieben.
Evtl hast du eine Ahnung woran das liegen kann?
Bei dir wird die Zeile im aktiven Tabellenblatt ermittelt, wenn dies nicht das Blatt "Arbeitsvorbereitung" ist hast du ein Problem. Du musst dieses Blatt aktivieren oder mit einem Wit-Konstrukt arbeiten - siehe unten
Gibt es hier evtl auch einen Code der eine Prüfung durchführt (evtl auch Addieren)wenn zwei Einträge mit selben Datum getätigt werden?
Vor dem Eintragen prüfen, ob Datum in Spalte schon vorhanden ist - siehe Beispiel in deiner Datei.
Entsprechend dann den A
weiteren Ablauf im Makro steuern.
Gruß
Franz
Private Sub CommandButton1_Click()
Dim zeile As Long
'Prüfung der Eingabe-Werte
If fncPruefung = False Then Exit Sub
'Werte in Tabellenblatt eintragen
With ThisWorkbook.Sheets("Arbeitsvorbereitung")
zeile = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
If zeile -1 Then
msgText = msgText & vbLf & "Bitte einen Eintrag in der Combox auswählen"
End If
If Textbox1 = "" Then
msgText = msgText & vbLf & "Textbox1 ist nicht ausgefüllt"
ElseIf Not IsNumeric(Textbox1.Value) Then
msgText = msgText & vbLf & "Wert in Textbox1 muss eine Zahl sein"
End If
If Textbox2 = "" Then
msgText = msgText & vbLf & "Textbox2 ist nicht ausgefüllt"
ElseIf Not IsNumeric(Textbox2.Value) Then
msgText = msgText & vbLf & "Wert in Textbox2 muss eine Zahl sein"
End If
If Textbox3 = "" Then
msgText = msgText & vbLf & "Textbox3 ist nicht ausgefüllt"
ElseIf Not IsNumeric(Textbox3.Value) Then
msgText = msgText & vbLf & "Wert in Textbox3 muss eine Zahl sein"
End If
fncPruefung = msgText = ""
If msgText "" Then
fncPruefung = False
MsgBox "Fehlerhafte Eingaben" & msgText, _
vbOKOnly, "Prüfung Eingabe-Werte"
Else
fncPruefung = True
End If
End Function
'Funktionen zum Eintragen von Textwerten in Zellen
Function fncCDec(Zelle As Range, strWert As String, _
Optional optLeer As String = "Loeschen", _
Optional optText As String = "Fehler", _
Optional Meldung As String = "", _
Optional Fehlerwert) As Boolean
'Zahlenwert aus Textbox in Zelle eintragen
fncCDec = True
If strWert = "" Then
Select Case optLeer
Case "Loeschen"
Zelle.ClearContents
Case "0"
Zelle.Value = 0
Case ""
Zelle.Value = ""
End Select
ElseIf IsNumeric(strWert) Then
Zelle.Value = CDec(strWert)
Else
'strWert is keine Zahl
Select Case optText
Case "Text"
Zelle.Value = strWert
Case ""
Zelle.Value = ""
Case "Fehler"
If Meldung = "" Then
Meldung = "in Zelle """ & Zelle.Address(False, False, xlA1) _
& """ einzutragender Wert ist keine Zahl!"
End If
MsgBox Meldung, vbOKOnly, "Eingabe-Prüfung Wert"
fncCDec = False
If Not IsMissing(Fehlerwert) "" Then Zelle.Value = Fehlerwert
End Select
End If
End Function
Function fncDatum(Zelle As Range, strWert As String, _
Optional optLeer As String = "Loeschen", _
Optional optText As String = "Fehler", _
Optional Meldung As String = "", _
Optional Fehlerwert) As Boolean
'Datumwert aus Textbox in Zelle eintragen
fncDatum = True
If strWert = "" Then
Select Case optLeer
Case "Loeschen"
Zelle.ClearContents
Case ""
Zelle.Value = ""
End Select
ElseIf IsDate(strWert) Then
Zelle.Value = CDate(strWert)
Else
'strWert is kein Datum
Select Case optText
Case "Text"
Zelle.Value = "'" & strWert
Case ""
Zelle.Value = ""
Case "Fehler"
If Meldung = "" Then
Meldung = "in Zelle """ & Zelle.Address(False, False, xlA1) _
& """ einzutragender Wert ist kein Datum!"
End If
MsgBox Meldung, vbOKOnly, "Eingabe-Prüfung Wert"
fncDatum = False
If Not IsMissing(Fehlerwert) "" Then Zelle.Value = Fehlerwert
End Select
End If
End Function
Function fncText(Zelle As Range, strWert As String, _
Optional optLeer As String = "Loeschen") As Boolean
'Text aus Textbox in Zelle eintragen
fncText = True
If strWert = "" Then
Select Case optLeer
Case "Loeschen"
Zelle.ClearContents
Case ""
Zelle.Value = ""
End Select
ElseIf IsNumeric(strWert) Then
Zelle.Value = "'" & strWert
Else
Zelle = strWert
End If
End Function