Userform Daten aktuallisieren
09.08.2023, 08:48
Ich habe 2 Userformen
("Auftragsnummer" für Eintragung in Tabelle)
("Bearbeiten" für die Aufträge)
Trage ich Aufträge ein, werden diese gespeichert.
offne ich Userform Bearbeiten, sind die gerade eingetragenen Einträge nicht in der liste.
wieder userform schließen und neu öffnen, dann sind sie in der liste.
Wie kann ich es hinbekommen, dass die gleich drin stehen?
Userform Auftragsnummer
Userform Bearbeiten
Vielen Dank für Eure Hilfe
("Auftragsnummer" für Eintragung in Tabelle)
("Bearbeiten" für die Aufträge)
Trage ich Aufträge ein, werden diese gespeichert.
offne ich Userform Bearbeiten, sind die gerade eingetragenen Einträge nicht in der liste.
wieder userform schließen und neu öffnen, dann sind sie in der liste.
Wie kann ich es hinbekommen, dass die gleich drin stehen?
Userform Auftragsnummer
Code:
Private Sub cmdAbbruch_Click()
'Formular schließen
Unload Me
End Sub
'Combobox Fremd/Pentol-LKW
Sub fill_txtFremd()
txtFremd.List = Range("Fremd").Value
End Sub
Private Sub UserForm_Initialize()
Label5.Visible = False
End Sub
Private Sub txtFremd_Change()
If txtFremd = "LKW Fremd" Then
txtLkw = "Bitte ausfüllen!"
txtLkw.List = Range("LKW_Fremd").Value
Else
txtLkw = ""
txtLkw.Clear
End If
End Sub
'Combobox ende
Private Sub cmdSpeichern_Click()
'Daten speichern, Formular schließen
Dim i As Long
Dim last As Long
Dim lngSuch
Dim LRow As Long
Dim rngC As Range
'cobAuftrag = ""
If txtAuftragsnummer = "" Then
MsgBox ("Bitte das Felder " & """" & "Auftragsnummer" & """" & " ausfüllen!")
Exit Sub
End If
LRow = Cells(Rows.Count, 1).End(xlUp).Row
lngSuch = Me.txtAuftragsnummer.Value
Set rngC = Range("D4:D" & LRow).Find(lngSuch, _
Range("D" & LRow), xlValues)
With Bearbeiten
If Not rngC Is Nothing Then
MsgBox "Auftragsnummer " & """" & lngSuch & """" & " ist bereits vorhanden!"
Else
If cboDatum = False And txtDatum < Date Then
MsgBox ("Bitte das aktuelle Datum " & """" & Date & """" & " oder ein in der Zukunft liegendes Datum eintragen!")
Exit Sub
End If
If txtDestination = "" Then
MsgBox ("Bitte das Felder " & """" & "Destination" & """" & " ausfüllen!")
Exit Sub
End If
If txtProdukt = "" Then
MsgBox ("Bitte das Felder " & """" & "Produkt" & """" & " ausfüllen!")
Exit Sub
End If
If txtMenge = "" Then
MsgBox ("Bitte das Felder " & """" & "Menge" & """" & " ausfüllen!")
Exit Sub
End If
If txtFremd = "LKW Fremd" And txtLkw = "" Then
MsgBox ("Bitte eine Auswahl zum Feld " & """" & "Fremd/Pentol" & """" & " treffen!")
Exit Sub
End If
If txtStatus = "" Then
MsgBox ("Bitte das Felder " & """" & "Status" & """" & " ausfüllen!")
Exit Sub
End If
If txtW_Container = "" Then
MsgBox ("Bitte das Felder " & """" & "weitere Container" & """" & " ausfüllen!")
Exit Sub
End If
If txtVersandstatus = "" Then
MsgBox ("Bitte das Felder " & """" & "Versandstatus" & """" & " ausfüllen!")
Exit Sub
End If
Label5.Visible = True 'Aufträge werden angelegt! Bitte warten.....
Me.Repaint
'Hauptnummer
last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1 'letzte Zeile
If cboDatum <> False Then
ActiveSheet.Cells(last, 3).Value = ""
Else
ActiveSheet.Cells(last, 3).Value = Format((Me.txtDatum.Value), "dd.mm.yyyy")
End If
ActiveSheet.Cells(last, 4).Value = Me.txtAuftragsnummer.Value
ActiveSheet.Cells(last, 5).Value = Me.txtDestination.Value
ActiveSheet.Cells(last, 6).Value = Me.txtProdukt.Value
ActiveSheet.Cells(last, 7).Value = Me.txtMenge.Value
ActiveSheet.Cells(last, 8).Value = Me.txtCharge.Value
ActiveSheet.Cells(last, 9).Value = Me.txtFremd.Value
ActiveSheet.Cells(last, 10).Value = Me.txtLkw.Value
ActiveSheet.Cells(last, 11).Value = Me.txtContainer.Value
ActiveSheet.Cells(last, 12).Value = Me.txtPlombennummer.Value
ActiveSheet.Cells(last, 13).Value = Me.txtZollplombe.Value
ActiveSheet.Cells(last, 14).Value = Me.txtSchiff.Value
If IsDate(Me.txtEta.Value) Then 'kann der Inhalt als Datum erkannt werden?
ActiveSheet.Cells(last, 15).Value = Format((Me.txtEta.Value), "dd.mm.yyyy")
Else
ActiveSheet.Cells(last, 15).Value = Me.txtEta.Value
End If
ActiveSheet.Cells(last, 16).Value = Me.txtStatus.Value
ActiveSheet.Cells(last, 17).Value = CDec(Me.txtW_Container.Value)
ActiveSheet.Cells(last, 18).Value = Me.txtInfo.Value
ActiveSheet.Cells(last, 19).Value = Me.txtVersandstatus.Value
For i = 1 To txtW_Container
last = last + 1
ActiveSheet.Cells(last, 3).Value = Format((Me.txtDatum.Value), "dd.mm.yyyy")
ActiveSheet.Cells(last, 4).Value = Me.txtAuftragsnummer.Value & "-" & i
ActiveSheet.Cells(last, 5).Value = Me.txtDestination.Value
ActiveSheet.Cells(last, 6).Value = Me.txtProdukt.Value
ActiveSheet.Cells(last, 7).Value = Me.txtMenge.Value
ActiveSheet.Cells(last, 8).Value = Me.txtCharge.Value
ActiveSheet.Cells(last, 9).Value = Me.txtFremd.Value
ActiveSheet.Cells(last, 10).Value = Me.txtLkw.Value
ActiveSheet.Cells(last, 11).Value = Me.txtContainer.Value
ActiveSheet.Cells(last, 12).Value = Me.txtPlombennummer.Value
ActiveSheet.Cells(last, 13).Value = Me.txtZollplombe.Value
ActiveSheet.Cells(last, 14).Value = Me.txtSchiff.Value
If IsDate(Me.txtEta.Value) Then 'kann der Inhalt als Datum erkannt werden?
ActiveSheet.Cells(last, 15).Value = Format((Me.txtEta.Value), "dd.mm.yyyy")
Else
ActiveSheet.Cells(last, 15).Value = Me.txtEta.Value
End If
ActiveSheet.Cells(last, 16).Value = Me.txtStatus.Value
ActiveSheet.Cells(last, 17).Value = CDec(Me.txtW_Container.Value)
ActiveSheet.Cells(last, 18).Value = Me.txtInfo.Value
ActiveSheet.Cells(last, 19).Value = Me.txtVersandstatus.Value
Next
MsgBox ("Der Auftrag " & """" & Me.txtAuftragsnummer.Value & """" & " wurde hinzugefühgt!")
If txtW_Container > 0 Then
MsgBox ("Es wurden noch " & """" & Me.txtW_Container.Value & """" & "weitere Container angelegt!")
End If
End If
End With
'letztezeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
'Range("C4:S" & letztezeile).HorizontalAlignment = xlLeft 'Zellenausrichtung
Unload Me
End Sub
'Listenprüfung nur zugelassene Werte aus Liste
'Land
Private Sub txtDestination_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If Not txtDestination.MatchFound Then
txtDestination = ""
MsgBox "Als Land sind nur Werte aus der Liste zugelassen!"
End If
End Sub
'Produkt
Private Sub txtProdukt_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If Not txtProdukt.MatchFound Then
txtProdukt = ""
MsgBox "Als Produkt sind nur Werte aus der Liste zugelassen!"
End If
End Sub
'Status
Private Sub txtStatus_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If Not txtStatus.MatchFound Then
txtStatus = ""
MsgBox "Im Status sind nur Werte aus der Liste zugelassen!"
End If
End Sub
'Versandstatus
Private Sub txtVersandstatus_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If Not txtVersandstatus.MatchFound Then
txtVersandstatus = ""
MsgBox "Im Versandstatus sind nur Werte aus der Liste zugelassen!"
End If
End Sub
'Listenprüfung Ende
Private Sub cobBearbeiten_Click()
Unload Me
Bearbeiten.Show
End SubUserform Bearbeiten
Code:
Private Sub cmdAbbruch_Click()
'Formular schließen
Unload Me
End Sub
Private Sub cmdAendern_Click()
'Daten ändern und Formular schließen
Dim rngFoundCell As Range
Dim strAntwort As String
If cobAuftrag.Text = "" Then
MsgBox ("Bitte einen Auftrag zum ändern auswählen!")
Exit Sub
End If
If Me.txtDestination = "" Then
MsgBox ("Bitte das Felder " & """" & "Destination" & """" & " ausfüllen!")
Exit Sub
End If
If Me.txtProdukt = "" Then
MsgBox ("Bitte das Felder " & """" & "Produkt" & """" & " ausfüllen!")
Exit Sub
End If
If Me.txtMenge = "" Then
MsgBox ("Bitte das Felder " & """" & "Menge" & """" & " ausfüllen!")
Exit Sub
End If
If Me.txtStatus = "" Then
MsgBox ("Bitte das Felder " & """" & "Status" & """" & " ausfüllen!")
Exit Sub
End If
If Me.txtW_Container = "" Then
MsgBox ("Bitte das Felder " & """" & "weitere Container" & """" & " ausfüllen!")
Exit Sub
End If
If Me.txtVersandstatus = "" Then
MsgBox ("Bitte das Felder " & """" & "Versandstatus" & """" & " ausfüllen!")
Exit Sub
End If
strAntwort = MsgBox("Soll die Änderung des Datensatz zum Auftrag " & """" & cobAuftrag.Text & """" & " gespeichert werden?", vbYesNo, "Datensatz speichern?")
Label5.Visible = True 'Aufträge werden angelegt! Bitte warten.....
Me.Repaint
If strAntwort = vbYes Then
LRow = Cells(Rows.Count, 1).End(xlUp).Row
lngSuch = Me.cobAuftrag.Value
Set rngFoundCell = Range("D4:D" & LRow).Find(Me.cobAuftrag, Range("D" & LRow), xlValues)
cobAuftrag = ""
Cells(rngFoundCell.Row, 3) = Format((Me.txtDatum), "dd.mm.yyyy")
Cells(rngFoundCell.Row, 5) = Me.txtDestination
Cells(rngFoundCell.Row, 6) = Me.txtProdukt
Cells(rngFoundCell.Row, 7) = Me.txtMenge
Cells(rngFoundCell.Row, 8) = Me.txtCharge
Cells(rngFoundCell.Row, 9) = Me.txtFremd
Cells(rngFoundCell.Row, 10) = Me.txtLkw
Cells(rngFoundCell.Row, 11) = Me.txtContainer
Cells(rngFoundCell.Row, 12) = Me.txtPlombennummer
Cells(rngFoundCell.Row, 13) = Me.txtZollplombe
Cells(rngFoundCell.Row, 14) = Me.txtSchiff
If IsDate(Me.txtEta.Value) Then 'kann der Inhalt als Datum erkannt werden?
Cells(rngFoundCell.Row, 15) = Format((Me.txtEta), "dd.mm.yyyy")
Else
Cells(rngFoundCell.Row, 15) = Me.txtEta
End If
Cells(rngFoundCell.Row, 16) = Me.txtStatus
Cells(rngFoundCell.Row, 17) = CDec(Me.txtW_Container)
Cells(rngFoundCell.Row, 18) = Me.txtInfo
Cells(rngFoundCell.Row, 19) = Me.txtVersandstatus
MsgBox ("Auftragsdaten zum Auftrag " & """" & lngSuch & """" & " wurden geändert!")
Else
If strAntwort = vbNo Then
MsgBox ("Es wurden keine Daten zum Auftrag " & """" & cobAuftrag & """" & " geändert!")
End If
End If
Unload Me
End Sub
'Listenprüfung nur zugelassene Werte aus Liste
'Land
Private Sub txtDestination_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim LRow As Long
Dim rngC As Range
LRow = Cells(Rows.Count, 1).End(xlUp).Row
lngSuch = Me.cobAuftrag.Value
Set rngC = Range("D4:D" & LRow).Find(lngSuch, _
Range("D" & LRow), xlValues)
If Not txtDestination.MatchFound Then
txtDestination = ""
MsgBox "Als Land sind nur Werte aus der Liste zugelassen!"
txtDestination = Cells(rngC.Row, 5)
End If
End Sub
'Produkt
Private Sub txtProdukt_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim LRow As Long
Dim rngC As Range
LRow = Cells(Rows.Count, 1).End(xlUp).Row
lngSuch = Me.cobAuftrag.Value
Set rngC = Range("D4:D" & LRow).Find(lngSuch, _
Range("D" & LRow), xlValues)
If Not txtProdukt.MatchFound Then
txtProdukt = Cells(rngC.Row, 6)
MsgBox "Als Produkt sind nur Werte aus der Liste zugelassen!"
End If
End Sub
'Status
Private Sub txtStatus_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim LRow As Long
Dim rngC As Range
LRow = Cells(Rows.Count, 1).End(xlUp).Row
lngSuch = Me.cobAuftrag.Value
Set rngC = Range("D4:D" & LRow).Find(lngSuch, _
Range("D" & LRow), xlValues)
If Not txtStatus.MatchFound Then
txtStatus = Cells(rngC.Row, 16)
MsgBox "Im Status sind nur Werte aus der Liste zugelassen!"
End If
End Sub
'Versandstatus
Private Sub txtVersandstatus_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim LRow As Long
Dim rngC As Range
LRow = Cells(Rows.Count, 1).End(xlUp).Row
lngSuch = Me.cobAuftrag.Value
Set rngC = Range("D4:D" & LRow).Find(lngSuch, _
Range("D" & LRow), xlValues)
If Not txtVersandstatus.MatchFound Then
txtVersandstatus = Cells(rngC.Row, 19)
MsgBox "Im Versandstatus sind nur Werte aus der Liste zugelassen!"
End If
End Sub
'Listenprüfung Ende
Private Sub cmdAuftrag_neu_Click()
Unload Me
Auftragsnummer.Show
End Sub
'Comboboxen Fremd/Pentol-LKW
Sub fill_txtFremd()
txtFremd.List = Range("Fremd").Value
End Sub
Private Sub txtFremd_Change()
If txtFremd = "LKW Fremd" Then
txtLkw = "Bitte ausfüllen!"
txtLkw.List = Range("LKW_Fremd").Value
Else
txtLkw = ""
txtLkw.Clear
End If
End Sub
'Combobox ende
'ComboBox cobAuftrag weckseln
'alle
Private Sub oballe_Aufträge_Click()
If Worksheets("Aufträge").Range("G1").Value = "Erledigt" Then
MsgBox "Es können keine " & """" & "erledigten" & """" & " Aufträgen bearbeitet werden, da diese ausgeblendet sind!" & vbNewLine & "Hierfür müssen alle Aufträge sichtbar sein!"
End If
If Worksheets("Aufträge").Range("G1").Value = "Offen" Then
MsgBox "Es können keine " & """" & "offenen" & """" & " Aufträgen bearbeitet werden, da diese ausgeblendet sind!" & vbNewLine & "Hierfür müssen alle Aufträge sichtbar sein!"
End If
cobAuftrag = ""
cobAuftrag.RowSource = "Aufträge"
Label1.Caption = "Es werden " & """" & "alle" & """" & " Aufträge auflisten!"
Label1.ForeColor = RGB(0, 0, 205)
End Sub
'offen
Private Sub oboffene_Aufträge_Click()
If Worksheets("Aufträge").Range("G1").Value = "Offen" Then
MsgBox "Es können keine " & """" & "offenen" & """" & " Aufträgen bearbeitet werden, da diese ausgeblendet sind!" & vbNewLine & "Hierfür müssen alle Aufträge sichtbar sein!"
End If
cobAuftrag = ""
cobAuftrag.RowSource = "Aufträge_offen"
Label1.Caption = "Es werden alle " & """" & "offene" & """" & " Aufträge auflisten!"
Label1.ForeColor = RGB(255, 0, 0) 'Rot
End Sub
'erledigt
Private Sub oberledigte_Aufträge_Click()
If Worksheets("Aufträge").Range("G1").Value = "Erledigt" Then
MsgBox "Es können keine " & """" & " erledigten" & """" & " Aufträgen bearbeitet werden, da diese ausgeblendet sind!" & vbNewLine & "Hierfür müssen alle Aufträge sichtbar sein!"
End If
cobAuftrag = ""
cobAuftrag.RowSource = "Aufträge_erledigt"
Label1.Caption = "Es werden alle " & """" & "erledigte" & """" & " Aufträge auflisten!"
Label1.ForeColor = RGB(34, 139, 34) 'Grün
End Sub
Private Sub UserForm_Initialize()
Dim varLabArr As Variant
Dim intAnz As Integer
Label5.Visible = False 'Laden anzeigen
If Worksheets("Aufträge").Range("G1").Value = "Erledigt" Then
MsgBox "Es können keine " & """" & "erledigten" & """" & " Aufträgen bearbeitet werden, da diese ausgeblendet sind!" & vbNewLine & "Hierfür müssen alle Aufträge sichtbar sein!"
End If
If Worksheets("Aufträge").Range("G1").Value = "Offen" Then
MsgBox "Es können keine " & """" & "offenen" & """" & " Aufträgen bearbeitet werden, da diese ausgeblendet sind!" & vbNewLine & "Hierfür müssen alle Aufträge sichtbar sein!"
End If
cobAuftrag = ""
cobAuftrag.RowSource = "Aufträge"
Label1.Caption = "Es werden " & """" & "alle" & """" & " Aufträge auflisten!"
oballe_Aufträge.Value = True
End Sub
Private Sub cobAuftrag_Click() 'Daten Kunden in Boxen anzeigen
Dim lngSuch
Dim i As Integer
Dim LRow As Long
Dim rngC As Range
'cobAuftrag = ""
LRow = Cells(Rows.Count, 1).End(xlUp).Row
lngSuch = Me.cobAuftrag.Value
Set rngC = Range("D4:D" & LRow).Find(lngSuch, _
Range("D" & LRow), xlValues)
With Bearbeiten
If Not rngC Is Nothing Then
.txtKW = Cells(rngC.Row, 2)
.txtDatum = Cells(rngC.Row, 3)
.txtDestination = Cells(rngC.Row, 5)
.txtProdukt = Cells(rngC.Row, 6)
.txtMenge = Cells(rngC.Row, 7)
.txtCharge = Cells(rngC.Row, 8)
.txtFremd = Cells(rngC.Row, 9)
.txtLkw = Cells(rngC.Row, 10)
.txtContainer = Cells(rngC.Row, 11)
.txtPlombennummer = Cells(rngC.Row, 12)
.txtZollplombe = Cells(rngC.Row, 13)
.txtSchiff = Cells(rngC.Row, 14)
.txtEta = Cells(rngC.Row, 15)
.txtStatus = Cells(rngC.Row, 16)
.txtW_Container = Cells(rngC.Row, 17)
.txtInfo = Cells(rngC.Row, 18)
.txtVersandstatus = Cells(rngC.Row, 19)
Else
MsgBox "Auftragsnummer " & """" & lngSuch & """" & " wurde nicht gefunden!"
End If
End With
End Sub
Private Sub Bearbeiten_Activate()
FillMyComboBox
End Sub
Public Sub FillMyComboBox()
'Tabelle1 durch Deinen Tabellenname ersetzen:
Sheets("Tabelle4").UsedRange.Offset(1, 0).Name = "snb"
cobAuftrag.List = Filter([transpose(if(isblank(snb),"~",snb))], "~", 0)
End Sub
Private Sub cobSuchen_Click()
Dim lngSuch
Dim i As Integer
Dim LRow As Long
Dim rngC As Range
LRow = Cells(Rows.Count, 1).End(xlUp).Row
lngSuch = Me.cobAuftrag.Value
Set rngC = Range("D4:D" & LRow).Find(lngSuch, _
Range("D" & LRow), xlValues)
With Bearbeiten
If Not rngC Is Nothing Then
.txtKW = Cells(rngC.Row, 2)
.txtDatum = Cells(rngC.Row, 3)
.txtDestination = Cells(rngC.Row, 5)
.txtProdukt = Cells(rngC.Row, 6)
.txtMenge = Cells(rngC.Row, 7)
.txtCharge = Cells(rngC.Row, 8)
.txtFremd = Cells(rngC.Row, 9)
.txtLkw = Cells(rngC.Row, 10)
.txtContainer = Cells(rngC.Row, 11)
.txtPlombennummer = Cells(rngC.Row, 12)
.txtZollplombe = Cells(rngC.Row, 13)
.txtSchiff = Cells(rngC.Row, 14)
.txtEta = Cells(rngC.Row, 15)
.txtStatus = Cells(rngC.Row, 16)
.txtW_Container = Cells(rngC.Row, 17)
.txtInfo = Cells(rngC.Row, 18)
.txtVersandstatus = Cells(rngC.Row, 19)
Else
MsgBox "Auftragsnummer " & """" & lngSuch & """" & " wurde nicht gefunden!"
cobAuftrag = ""
.txtKW = ""
.txtDatum = ""
.txtDestination = ""
.txtProdukt = ""
.txtMenge = ""
.txtCharge = ""
.txtFremd = ""
.txtLkw = ""
.txtContainer = ""
.txtPlombennummer = ""
.txtZollplombe = ""
.txtSchiff = ""
.txtEta = ""
.txtStatus = ""
.txtW_Container = ""
.txtInfo = ""
.txtVersandstatus = ""
End If
End With
End SubVielen Dank für Eure Hilfe
