AW: Werte per userform in bestimmte Tabelle eintragen
27.11.2019 13:06:55
volti
Hallo Ludger,
hier mal eine (erste) Idee, wie Du Dein Anliegen lösen könntest. Natürlich musst Du das selbst noch weiter entsprechend ergänzen:
Zunächst wird die Userform (z.B. über einen Button) aufgerufen, die Daten aus Tabelle1 übertagen. Dann kann der User den Rest ergänzen und "Beenden" klicken.
In der Beenden-Sub könntest Du für jedes Feld noch eine Plausi machen, ob dies auch ausgefüllt ist....
Hier die Beenden-Sub in das UF-Modul aufnehmen:
Option Explicit
Private Sub cbbeenden_Click()
'Abschluss-Plausibilisierung für diverse Muss-Felder
With Me
If .cboneukunde = "?" Then
MsgTxt "Du hast das Feld 'Neukunde' nicht ausgefüllt!""
.cboneukunde.SetFocus: Exit Sub
End If
If .txtstraße = "" Then
MsgTxt "Du hast keine Straße eingegeben!"
.txtstraße.SetFocus: Exit Sub
End If
.Hide
Fill_PDF
End With
End Sub
Private Sub MsgTxt(Txt As String)
MsgBox Txt, vbOKOnly Or vbExclamation, "Fehlerhafte Eingabe"
End Sub
alles korrekt, dann UF schließen und PDF füllen
Die Initialisierungs-Sub kann weg und wenn Du nicht eine Sofortübertragung der Daten eines Feldes wünscht, können Deine anderen Sub's auch weg.
Die Füllen-Sub's einfach in ein Modul einfügen:
Option Explicit
Sub Test()
Fill_UF "Fa. Bon*"
End Sub
Sub Fill_UF(Such As String)
'Füllen der Felder der Userform anhand der Tabelle1-Daten
'Zunächst die gewünschte Zeile suchen und aus dieser dann die Daten in UF übertragen
'Es kann alternativ auch eine Zeilennummer übergeben werden
'Userform zur weiteren Bearbeitung aufrufen
Dim UF As Object, WSh As Worksheet, iZeile As Long
Set UF = UserForm1
Set WSh = ThisWorkbook.Sheets("Tabelle1") 'ggf. Tabellennamen anpassen
On Error Resume Next
If Val(Such) > 0 Then
iZeile = Val(Such)
Else
iZeile = 0
'Suchbegriff in Spalte L suchen
iZeile = Application.WorksheetFunction.Match(Such, WSh.Range("L:L"), 0)
End If
If iZeile > 0 Then
With WSh
'Jetzt die Daten übernehmen
With UF.cboneukunde
.AddItem "Ja"
.AddItem "Nein"
.Value = "?"
End With
UF.txtfahrer = Trim$(Replace(.Cells(2, "L").Value, "Name des Fahrers:", ""))
UF.txtDatum = .Cells(iZeile, "B").Value
UF.txtanfang_uhrzeit = Format$(.Cells(iZeile, "C").Value, "hh:mm")
UF.txtende_uhrzeit = Format$(.Cells(iZeile, "D").Value, "hh:mm")
UF.txtstunden_gesamt = Format$((.Cells(iZeile, "D").Value - .Cells(iZeile, "C").Value) * 24, "#0.0")
If Val(UF.txtstunden_gesamt) < 0 Then UF.txtstunden_gesamt = "Error! <0"
UF.txtkm_anfang = .Cells(iZeile, "E").Value
UF.txtkm_ende = .Cells(iZeile, "F").Value
UF.txtkm_gesamt = UF.txtkm_ende - UF.txtkm_anfang
If Val(UF.txtkm_gesamt) < 0 Then UF.txtkm_gesamt = "Error! <0"
UF.txtort = .Cells(iZeile, "I").Value
UF.txtkundenNr = .Cells(iZeile, "K").Value
UF.txtname = .Cells(iZeile, "L").Value
UF.Show
End With
End If
Set UF = Nothing
End Sub
Sub Fill_PDF()
Dim UF As Object
Set UF = UserForm1
With ThisWorkbook.Sheets("PDF") 'ggf. Tabellennamen anpassen
.Select
.Cells(5, "G").Value = UF.txtDatum
.Cells(7, "G").Value = UF.txtfahrer
.Cells(12, "G").Value = UF.txtname
.Cells(13, "G").Value = UF.txtstraße
.Cells(14, "G").Value = UF.t
.Cells(14, "J").Value = UF.txtort
.Cells(16, "G").Value = UF.txtkundenNr
.Cells(19, "I").Value = UF.txtanfang_uhrzeit
.Cells(19, "N").Value = UF.txtende_uhrzeit
.Cells(19, "S").Value = UF.txtstunden_gesamt
.Cells(20, "I").Value = UF.txtkm_anfang
.Cells(20, "N").Value = UF.txtkm_ende
.Cells(20, "S").Value = UF.txtkm_gesamt
.Cells(36, "B").Value = "Neukunde: " & UF.cboneukunde
Set UF = Nothing
End With
End Sub
Tipp:
ja/Nein-Angaben könntest Du auch mit Checkboxen besser lösen.
Bau es bei Dir mal ein und probiere einfach mal, ob es so geht.
Ich hoffe, dass es so gedacht war.
viele Grüße
Karl-Heinz