Daten aus Tabelle in Textfelder schreiben

Question

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

Answer 1

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?

Answer 2

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

Answer 3

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

Answer 4

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

Answer 5

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

Answer 6

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

Answer 7

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

Answer 8

Hallo Peter,

versuche mal statt

... = null

den Code

isnull(...)


Gruß
Ralf

Answer 9

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

Answer 10

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