Daten aus Tabelle in Textfelder schreiben
Hallo Accperten,
ich bräuchte mal wieder Euren kompetenten Rat.
Ich habe ein Formular, in das ich via VBA neue Datensätze anlegen kann.
Nun geht es aber daran auch bereits bestehende Datensätze zu ändern.
Ich stelle mir dabei vor, dass wenn ich eine Bestellnummer in das Textfeld txt_From eingebe, anschließend ein VBA-Code die Tabelle Tbl_Sales_Data nach dieser Bestellnummer durchsucht.
Sollte VBA diese Bestellnummer finden, sollen die Werte wie Listenpreise und Rabatte in die entsprechenden Textfelder auf dem Formular geschrieben werden.
!List_price_per_unit_EUR = Nz(Forms!Frm_Sales_Data!txt_List_price_per_unit_EUR)
!Special_handling_costs_per_unit_EUR = Nz(Forms!Frm_Sales_Data!txt_Handling_costs_per_unit_EUR)
!Estimated_freight_costs_per_unit_EUR = Nz(Forms!Frm_Sales_Data!txt_Freight_costs_per_unit_EUR)
!Insurance_costs_per_unit_EUR = Nz(Forms!Frm_Sales_Data!txt_Insurance_costs_per_unit_EUR)
!Contracted_value_per_unit_EUR = Nz(Forms!Frm_Sales_Data!txt_Contracted_value_per_unit_EUR)
Leider schaffe ich es nicht mal, dass er die Bestellnummer aus dem Textfeld txt_From sucht, so dass ich diesen Wert fest vorgeben musste (123456).
Private Sub txt_From_LostFocus()
Dim Comar As String
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
rst.Open "Tbl_Sales_Data", CurrentProject.AccessConnection, adOpenKeyset, adLockOptimistic
ID = Forms!Frm_Sales_Data!txt_From
Bestnr = "Bestellnummer='123456'"
rst.Find Bestnr
Könnt Ihr mir vielleicht erklären, was ich ändern muss?
Bis dahin schöne Ostern.
Peter
Antwort schreiben
Antwort 1 von Marie vom 14.04.2021, 13:47 Options
Deinen Code verstehe ich nicht. Wenn Du dich in dem Formular befindest, in dem der Datensatz angezeigt werden soll mit der Bestellnummer, dann geht das ganz einfach so:
Private Sub txt_From_AfterUpdate()
Me.RecordsetClone.FindFirst "[Bestellnummer] = " & Me![txt_From]
Me.Bookmark = Me.RecordsetClone.Bookmark
End Sub
oder wolltest Du was anderees?
Antwort 2 von Marie vom 14.04.2021, 14:13 Options
Hm, wenn der Datensatz nicht angezeigt werden soll, weil die Daten aus dem Formular in der Tabelle bei dem Datensatz eingetragen werden sollen, dann eher so:
' Hier in SQL-Abfrage noch alle anderen Felder rein die geändert werden sollen
SQL = "SELECT DISTINCTROW ID, Bestellnummer FROM Tbl_Sales_Data"
Set Dbs = CurrentDb
Kriterien = "[Bestellnummmer] = " & Me![txt_From]
Set rst = Dbs.OpenRecordset(SQL)
rst.FindFirst Kriterien
If rst.NoMatch Then
MsgBox "Keinen Datensatz mit Bestellnummer " & Me![txt_From] & " gefunden!", vbCritical, "Bestellnummer " _
& Me![txt_From] & " existiert noch nicht!"
End If
Else
' füge die Daten ein
End If
Gruß Marie
Antwort 3 von Peter3011 vom 15.04.2021, 23:03 Options
Hallo Marie,
Dein erstes Makro kenne ich, aber leider ist es nicht das was ich will.
Am besten ich beschreibe den Aufbau meines Formulars erst einmal ausführlich.
Ich habe folgende Textboxen, in die die Seriennummern eingegeben werden (Primärschlüssel):
txt_To enthält die erste Seriennummer eines Projektes
txt_From enthält die letzte Seriennumer eines Projektes
... also z. B. Seriennummer 1 bis 10. Das hat den Vorteil, dass ich die Seriennummern nicht einzeln eingeben muss (dazugehöriges Makro ist unten).
Zu diesen Textboxen Seriennummern gehören die u. g. Textboxen
txt_Comments_Sales_OrdNo
txt_Comments_Sales_Comar)
txt_Project
txt_Qty
txt_Annex
txt_Base_Discount
txt_Additional_Discount
txt_List_Price_per_Unit_USD
txt_Special_Handling_Costs_per_Unit_USD
txt_Estimated_Freight_Costs_per_Unit_USD
txt_Insurance_Costs_per_Unit_USD
txt_Contracted_Value_per_Unit_USD
txt_List_Price_per_Unit_EUR
txt_Special_Handling_Costs_per_Unit_EUR
txt_Estimated_Freight_Costs_per_Unit_EUR txt_Insurance_Costs_per_Unit_EUR
txt_Contracted_Value_per_Unit_EUR
Alle Werte der Textboxen werden in die Tabelle Sales_Data geschrieben.
Hier das Makro, mit dem ich die Daten aus den Textboxen in die Tabelle eintrage.
Private Sub cobu_Data_Entry_Click()
On Error GoTo Err_Command10_Click
Dim rst As ADODB.Recordset
Dim conn As ADODB.Connection
Dim txt_To As Variant
Set rst = New ADODB.Recordset
Set conn = CurrentProject.AccessConnection
rst.Open "Tbl_Sales_Data", conn, adOpenKeyset, adLockOptimistic
Forms!Frm_Sales!txt_To = IIf(IsNull(Forms!Frm_Sales!txt_To), Forms!Frm_Sales!txt_From, Forms!Frm_Sales!txt_To)
For ID = Forms!Frm_Sales!txt_From To Forms!Frm_Sales!txt_To
With rst
If .Supports(adAddNew) Then
.AddNew
!OrdNo= ID
!Comments_Sales_OrdNo= IIf(IsNull(Forms!Frm_Sales!txt_Comments_Sales_OrdNo), "0", Forms!Frm_Sales!txt_Comments_Sales_OrdNo)
!Project = IIf(IsNull(Forms!Frm_Sales!txt_Project), "0", Forms!Frm_Sales!txt_Project)
!Qty = IIf(IsNull(Forms!Frm_Sales!txt_Qty), "0", Forms!Frm_Sales!txt_Qty)
!Annex = IIf(IsNull(Forms!Frm_Sales!txt_Annex), "0", Forms!Frm_Sales!txt_Annex)
!Base_discount = IIf(IsNull(Forms!Frm_Sales!txt_Base_Discount), "0", Forms!Frm_Sales!txt_Base_Discount)
!Additional_Discount = IIf(IsNull(Forms!Frm_Sales!txt_Additional_Discount), "0", Forms!Frm_Sales!txt_Additional_Discount)
!List_price_per_unit_USD = IIf(IsNull(Forms!Frm_Sales!txt_List_Price_per_Unit_USD), "0", Forms!Frm_Sales!txt_List_Price_per_Unit_USD)
!Special_handling_costs_per_unit_USD = IIf(IsNull(Forms!Frm_Sales!txt_Special_Handling_Costs_per_Unit_USD), "0", Forms!Frm_Sales!txt_Special_Handling_Costs_per_Unit_USD)
!Estimated_freight_costs_per_unit_USD = IIf(IsNull(Forms!Frm_Sales!txt_Estimated_Freight_Costs_per_Unit_USD), "0", Forms!Frm_Sales!txt_Estimated_Freight_Costs_per_Unit_USD)
!Insurance_costs_per_unit_USD = IIf(IsNull(Forms!Frm_Sales!txt_Insurance_Costs_per_Unit_USD), "0", Forms!Frm_Sales!txt_Insurance_Costs_per_Unit_USD)
!Contracted_value_per_unit_USD = IIf(IsNull(Forms!Frm_Sales!txt_Contracted_Value_per_Unit_USD), "0", Forms!Frm_Sales!txt_Contracted_Value_per_Unit_USD)
!List_price_per_unit_EUR = IIf(IsNull(Forms!Frm_Sales!txt_List_Price_per_Unit_EUR), "0", Forms!Frm_Sales!txt_List_Price_per_Unit_EUR)
!Special_handling_costs_per_unit_EUR = IIf(IsNull(Forms!Frm_Sales!txt_Special_Handling_Costs_per_Unit_EUR), "0", Forms!Frm_Sales!txt_Special_Handling_Costs_per_Unit_EUR)
!Estimated_freight_costs_per_unit_EUR = IIf(IsNull(Forms!Frm_Sales!txt_Estimated_Freight_Costs_per_Unit_EUR), "0", Forms!Frm_Sales!txt_Estimated_Freight_Costs_per_Unit_EUR)
!Insurance_costs_per_unit_EUR = IIf(IsNull(Forms!Frm_Sales!txt_Insurance_Costs_per_Unit_EUR), "0", Forms!Frm_Sales!txt_Insurance_Costs_per_Unit_EUR)
!Contracted_value_per_unit_EUR = IIf(IsNull(Forms!Frm_Sales!txt_Contracted_Value_per_Unit_EUR), "0", Forms!Frm_Sales!txt_Contracted_Value_per_Unit_EUR)
.Update
End If
End With
Next ID
rst.Close
Set rst = Nothing
MsgBox ("Data were entered succesfully!")
Exit_Command10_Click:
Exit Sub
Err_Command10_Click:
MsgBox Err.Description
Resume Exit_Command10_Click
End Sub
Meine Frage ist nun, wie ich meine bereits eingegebenen Daten mit Hilfe der gleichen o. g. Textboxen ändern kann, da mein Makro ja nur Daten erfasst, für die noch keine Seriennummer existiert.
Wenn ich also in die Textbox txt_To die Seriennummer eingebe und dieses Feld anschließend verlasse, sollen in alle anderen Textboxen die dazugehörigen Daten erscheinen. Der Sinn dahinter ist, das meine Kollegen und ich auf einen Blick, die Eingaben sehen und auch hinterfragen können (von den Vorstellungen meines Chefs ganz zu schweigen).
Sollen dennoch Änderungen vorgenommen werden, so sollen die Eingaben wieder über die Textboxen laufen, d. h. die bisherigen Eingaben sollen überschrieben werden.
Vielleicht ist das alles ein bisschen viel auf einmal aber es gehört nun mal zusammmen.
Ich hoffe, dass mein Anliegen jetzt klarer beschrieben ist.
Danke für Deine Hilfe, Marie.
Gruss
Peter
Antwort 4 von RaHi vom 15.04.2021, 23:36 Options
Hallo Peter,
das wird ziemlich unverständlich was du da vor hast. Angenommen du willst neue Daten aufnehmen, dann würde bei der Eingabe des txt_to-Feldes die Daten für die Neuanlagen überschrieben mit den Werten zu dem Datensatz aus txt_to. Willst du das wirklich?
Falls ja, öffnest du das Recordset mit "open" und dem where-Kriterium aus txt_to. Statt dem Recordset die Feldwerte zuzu weisen, machst du es umgekehrt, du weist den Feldvariablen die Recordwerte zu. Du musst natürlich über ein "if rec.eof" nicht vorhandene txt_to-Daten abfangen.
Falls dein Chef andere Vorstellungen hat, solltest du mit deinem Chef darüber reden, sonst ist einiges für die Tonne ;-)
Gruß
Ralf
Antwort 5 von Peter3011 vom 20.04.2021, 17:38 Options
Hallo Ralf,
Dein Hinweis hat uns ziemliches Kopfzerbrechen beschert ;).
Dennoch wollen wir am Ansatz Von ... Bis festhalten, weil es jede Menge Eingabeaufwand sparen kann.
Jedoch haben wir uns folgendes Adjustment überlegt:
Und zwar wollen wir alle Datensätze, die für zu den OrdNos gehören miteinander vergleichen. Stimmen die Werte überein, so sollen diese in die entsprechenden Textfelder reingeschrieben werden. Sollten sie nicht übereinstimmen, so soll in das Textfeld ein Hinweis auf die unterschiedlichen Daten geschrieben werden "Data are not the same".
Über eine If Schleife könnte dann verhindert werden, dass die alten Werte überschrieben werden.
Mit folgenden Makro habe ich versucht, wenigstens erst mal die Werte in den Textboxen anzuzeigen, aber das schlägt irgendwie fehl.
Private Sub txt_From_LostFocus()
'Declarations
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strsql As String
Dim comar As String
Dim Tbl_Sales_Data As Collection
Set db = CurrentDb
strsql = "Select * FROM Tbl_Sales_Data" & varsearch
If Not IsMissing(varsearch) Then
strsql = strsql & " WHERE " & varsearch
End If
Set rst = db.OpenRecordset(strsql, dbOpenDynaset)
Set Tbl_Sales_Data = New Collection
Do While Not rst.EOF
With comar
.txt_List_price_per_unit_USD = rst!List_price_per_unit_USD
.txt_Handling_costs_per_unit_USD = rst!!Special_handling_costs_per_unit_USD
End With
Tbl_Sales_Data.Add comar
rst.MoveNext
Loop
End Sub
Zwischenzeitlich bin ich auch auf DLookup gestoßen, was mich aber auch nicht zum Ziel geführt hat.
Was mache ich in meinem Makro falsch? Mit VBA in ACCESS habe ich mich noch nicht angefreundet. Das ist wesentlich abstrakter als in EXCEL.
Gruß
Peter
Antwort 6 von RaHi vom 20.04.2021, 23:04 Options
Hallo Peter,
der letzte Code hat leider zuviele Fehler, um ihn vernünftig korrigieren zu können. So ganz wir auch die Idee nicht ersichtlich. Deshalb hier ein neuer Ansatz mit der Bitte um gehörige Kritik, wenn ich daneben liege.
Das Formular mit den VON--BIS-Feldern könnte man doch so belassen wie es ist - zur erffektiven Datenerfassung für eine ganze Reihe von Datensätzen. Es erfüllt deine Anforderungen. Um aber Daten zu ändern, würde ich ein neues Formular entwerfen, bei dem die Eingabefelder an die Felder der Tabellen gebunden sind. Damit hast du die Möglichkeit z.B. die Filterfunktionen von Access selbst zu nutzen und die sind gar nicht so schlecht. Falls du mit dem Gedanken spielst von einem existierenden Datensatz die Werte für dieVON-BIS-Eingabe zu verwenden, würde ich von dem letzt genannten Formular aus gehen ung ggf die Felder des VON-BIS-Formulars damit füllen. Hört sich villeicht etwas kompliziert an, aber ich glaube, dass dieses Verfahren mehr bringt. Was hältst du von meinen Überlegungen?
Gruß
Ralf
Antwort 7 von Peter3011 vom 04.05.2021, 16:26 Options
Hallo Ralf,
ich habe mich in den letzten 14 Tagen intensiv mit meinem Anliegen beschäftigt und denke eine einigermaßen akzeptable Lösung zu haben. Zumindest funktioniert sie erst einmal auf Projektebene.
Private Sub txt_Project_LostFocus()
On Error GoTo Err_Command10_Click
'------------
'Preparations
'------------
'Declarations
Dim rst As New ADODB.Recordset
'------
'Checks
'------
If Forms!Frm_Logistic_Data!txt_Project = Null Then
GoTo Exit_Command10_Click
End If
'Open Table
rst.Open "SELECT * FROM Tbl_Logistic_Data where Project = '" & Forms!Frm_Logistic_Data!txt_Project & "' ORDER BY OrdNo", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
'-------------------------
'Enter data into textboxes
'-------------------------
Forms!Frm_Logistic_Data!txt_Comments_Logistics_Project = rst!Comments_Logistics_Project
Forms!Frm_Logistic_Data!txt_Comments_Logistics_Annex = rst!Comments_Logistics_Annex
Forms!Frm_Logistic_Data!txt_Comments_Logistics_Comars = rst!Comments_Logistics_Comar
Forms!Frm_Logistic_Data!txt_ship_to_address = rst!ship_to_address
Forms!Frm_Logistic_Data!txt_Person_in_charge = rst!Person_in_charge
Forms!Frm_Logistic_Data!txt_Release_Date = rst!Release_Date
Forms!Frm_Logistic_Data!txt_Shipping_lines_forwarder_in_Europe = rst!Shipping_lines_forwarder_in_Europe
Forms!Frm_Logistic_Data!txt_Requested_date_arriving = rst!Requested_date_arriving
Forms!Frm_Logistic_Data!txt_Container_RoRo = rst!Container_RoRo
Forms!Frm_Logistic_Data!txt_Docs_to_Bank = rst!Docs_to_Bank
While Not rst.EOF
If Forms!Frm_Logistic_Data!txt_Comments_Logistics_Project = rst!Comments_Logistics_Project Then
Forms!Frm_Logistic_Data!txt_Comments_Logistics_Project = Forms!Frm_Logistic_Data!txt_Comments_Logistics_Project
Else: Forms!Frm_Logistic_Data!txt_Comments_Logistics_Project = ""
End If
If Forms!Frm_Logistic_Data!txt_Comments_Logistics_Annex = rst!Comments_Logistics_Annex Then
Forms!Frm_Logistic_Data!txt_Comments_Logistics_Annex = Forms!Frm_Logistic_Data!txt_Comments_Logistics_Annex
Else: Forms!Frm_Logistic_Data!txt_Comments_Logistics_Annex = ""
End If
If Forms!Frm_Logistic_Data!txt_Comments_Logistics_OrdNo = rst!Comments_Logistics_OrdNo Then
Forms!Frm_Logistic_Data!txt_Comments_Logistics_OrdNo= Forms!Frm_Logistic_Data!txt_Comments_Logistics_OrdNo Else: Forms!Frm_Logistic_Data!txt_Comments_Logistics_OrdNo= ""
End If
If Forms!Frm_Logistic_Data!txt_ship_to_address = rst!ship_to_address Then
Forms!Frm_Logistic_Data!txt_ship_to_address = Forms!Frm_Logistic_Data!txt_ship_to_address
Else: Forms!Frm_Logistic_Data!txt_ship_to_address = ""
End If
If Forms!Frm_Logistic_Data!txt_Person_in_charge = rst!Person_in_charge Then
Forms!Frm_Logistic_Data!txt_Person_in_charge = Forms!Frm_Logistic_Data!txt_Person_in_charge
Else: Forms!Frm_Logistic_Data!txt_Person_in_charge = ""
End If
If Forms!Frm_Logistic_Data!txt_Release_Date = rst!Release_Date Then
Forms!Frm_Logistic_Data!txt_Release_Date = Forms!Frm_Logistic_Data!txt_Release_Date
Else: Forms!Frm_Logistic_Data!txt_Release_Date = ""
End If
If Forms!Frm_Logistic_Data!txt_Shipping_lines_forwarder_in_Europe = rst!Shipping_lines_forwarder_in_Europe Then
Forms!Frm_Logistic_Data!txt_Shipping_lines_forwarder_in_Europe = Forms!Frm_Logistic_Data!txt_Shipping_lines_forwarder_in_Europe
Else: Forms!Frm_Logistic_Data!txt_Shipping_lines_forwarder_in_Europe = ""
End If
If Forms!Frm_Logistic_Data!txt_Requested_date_arriving = rst!Requested_date_arriving Then
Forms!Frm_Logistic_Data!txt_Requested_date_arriving = Forms!Frm_Logistic_Data!txt_Requested_date_arriving
Else: Forms!Frm_Logistic_Data!txt_Requested_date_arriving = ""
End If
If Forms!Frm_Logistic_Data!txt_Container_RoRo = rst!Container_RoRo Then
Forms!Frm_Logistic_Data!txt_Container_RoRo = Forms!Frm_Logistic_Data!txt_Container_RoRo
Else: Forms!Frm_Logistic_Data!txt_Container_RoRo = ""
End If
If Forms!Frm_Logistic_Data!txt_Docs_to_Bank = rst!Docs_to_WWL_Bank Then
Forms!Frm_Logistic_Data!txt_Docs_to_Bank = Forms!Frm_Logistic_Data!txt_Docs_to_Bank
Else: Forms!Frm_Logistic_Data!txt_Docs_to_Bank = ""
End If
rst.MoveNext
Wend
'Refresh Subforms
Forms!Frm_Logistic_Data.Requery
'---------------
'Close procedure
'---------------
Exit_Command10_Click:
'rst.Close
Exit Sub
Err_Command10_Click:
MsgBox Err.Description
Resume Exit_Command10_Click
End Sub
Ich habe leider nur ein kleines Problem mit folgenden Befehl:
If Forms!Frm_Logistic_Data!txt_Project = Null Then
GoTo Exit_Command10_Click
End If
Mit diesem Befehl will prüfen, ob die Eingabe im Textfeld "Project" gelöscht wurde. Leider funktioniert das nicht, auch nicht mit "" oder IS NULL. Ich lösche das Textfeld ganz normal mit Delete oder Backspace.
Hast Du hierfür vielleicht einen Tipp.
Danke und eine schöne Woche noch.
Gruß
Peter
Antwort 8 von RaHi vom 04.05.2021, 18:23 Options
Hallo Peter,
versuche mal statt
... = null
den Code
isnull(...)
Gruß
Ralf
Antwort 9 von RaHi vom 04.05.2021, 21:36 Options
Hallo Peter,
ich habe mir deinen Code noch mal angeschaut. Du hast "rst.close" auskommentiert, das kann zu bösen Fehlern führen, gerade, wenn du diese Routine öfters ausführst. Dann noch einen kleinen Tipp zu deinen if-Then-Else Konstruktionen. Hier können sich auch schwer zu findende Fehler einschleichen, deshalb hier eine Variante, vielleich gefällt sie dir:
Zunächst definierst du eine zusätzliche Funktion im Codebereich deines Formulars:
Public Function setzeWert(formularfeld As Variant, recwert As Variant) As Variant
If formularfeld = recwert Then
setzeWert = formularfeld
Else
setzeWert = ""
End If
End Function
und ersetzt die If-Then-Else-Konstruktionen durch
Me!txt_Comments_Logistics_Project = setzewert(Me!txt_Comments_Logistics_Project, rst!Comments_Logistics_Project)
Me!txt_Comments_Logistics_Annex = setzewert (Me!txt_Comments_Logistics_Annex, rst!Comments_Logistics_Annex)
usw. Damit hast du an einer Stelle die Eigenschaft der Zuordnung definiert. Somit ist eine Anpassung ein leichtes. Hier könntest du eventuelle Null-Werte zentral kontrollieren, ohne dies in jeder If-Anweisung einzubauen.
Bitte nicht falsch verstehen, dies ist nur eine Anregung.
Gruß
Ralf
Antwort 10 von Peter3011 vom 05.05.2021, 14:14 Options
Hallo Ralf,
Danke für Deinen Tipp. Es hat natürlich gleich funktioniert.
If IsNull(Forms!Frm_Logistic_Data!txt_Project) Then
GoTo Exit_Command10_Click
End If
Und genau diese Bedingung ist der Grund, weshalb ich rst.close vorerst auskommentiert habe. Denn wenn die o. g. Bedingung erfüllt ist, ist rst noch nicht geöffnet worden. D. h., dass ich in einer Endlosschleife lande, weil er immer wieder die Fehlermeldung bringt.
Exit_Command10_Click:
rst.Close
Exit Sub
Err_Command10_Click:
MsgBox Err.Description
Resume Exit_Command10_Click
Ich habe einfach Exit_Command11_Click angelegt und nun ist das Problem wieder gelöst
Exit_Command11_Click:
Exit Sub
Wäre das auch Deine Lösung gewesen.
Deinen anderen Vorschlag bzgl. der Bedingungen sehe ich mir gerade an.
Danke und frohes Schaffen noch.
Peter
Antwort 11 von RaHi vom 05.05.2021, 16:37 OptionsLösung
Hallo Peter,
ich setze in der Regel nach den Exit-Label direkt den Befehl [/code]On Error resume next[/code]da ich ab hier nur noch
aufräumen möchte. Würde dein rst.close aus welchem Grund auch immer einen Fehler verursachen, hättest du eine
Endlosschleife durch die Fehlerbehandlung.
Deine Sprungmarke am Anfang kannst du umgehen, wenn du auf not isnull(...) abfragst und das endif hinter den requery-Befehl
setzt.
Gruß Ralf
Antwort 12 von Peter3011 vom 06.05.2021, 11:16 Options
Hallo Ralf,
habe Deine Funktion und Dein on error erfolgreich bei mir eingebaut.
Danke für den Tipp.
Gruß
Peter