Aus einer Tabelle auf Rufen kann und in weiteren Textboxen Anzeigen lasen Kann
https://www.herber.de/bbs/user/80435.xls
Für Hilfe danke ich schon mal.
Gruss Fredy
Private Sub cmdShow_Click() 'aktiviert die Anzeige der Daten
Set frm = UserForm1
With frm
.txtBox1.SetFocus
.txtBox2.Value = ActiveCell.Offset(0, 2).Value
.txtBox3.Value = ActiveCell.Offset(0, 3).Value
.txtBox4.Value = ActiveCell.Offset(18, 2).Value
.txtBox5.Value = ActiveCell.Offset(18, 3).Value
.txtBox6.Value = ActiveCell.Offset(18, 8).Value
End With
End Sub
Private Sub CommandButton1_Click()
Set frm = inventar
With frm
.txtBox1.SetFocus
.txtBox2.Value = ActiveCell.Offset(0, 2).Value
.txtBox3.Value = ActiveCell.Offset(0, 3).Value
.txtBox4.Value = ActiveCell.Offset(18, 2).Value
.txtBox5.Value = ActiveCell.Offset(18, 3).Value
.txtBox6.Value = ActiveCell.Offset(18, 8).Value
End With
End Sub
Private Sub CommandButton2_Click()
Dim zelle As Long
With Worksheets("Tabelle 1")
zelle = .Cells(Rows.Count, 2).End(xlUp).Row + 1
.Cells(zelle, 2) = TextBox2
.Cells(zelle, 3) = TextBox3
.Cells(zelle, 4) = TextBox4
.Cells(zelle, 5) = TextBox5
.Cells(zelle, 6) = TextBox6
.Cells(zelle, 7) = TextBox7
.Cells(zelle, 8) = TextBox8
End With
End Sub
Private Sub CommandButton3_Click()
Dim Tb As Integer
On Error Resume Next
For Tb = 1 To 8
Me.Controls("TextBox" & Tb) = ""
Next Tb
End Sub
Private Sub TextBox6_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox6.Value = Format(TextBox6.Value, "#,##0.00 SFR")
End Sub
Private Sub TextBox1_afterupdate()
Dim lRow, i As Integer
With Sheets(1)
lRow = Application.Match(CLng(TextBox1), .Columns(1), 0)
If Not IsError(lRow) Then
For i = 2 To 8
Controls("Textbox" & i) = .Cells(lRow, i)
Next
Else
TextBox1.SetFocus
End If
End With
End Sub
Private Sub CommandButton1_Click()
Dim lRow As Long, i As Integer
With Sheets(1)
lRow = Application.Match(CLng(TextBox1), .Columns(1), 0)
If Not IsError(lRow) Then
For i = 2 To 8
.Cells(lRow, i) = Controls("Textbox" & i)
Next
End If
End With
End Sub
Die Rechtschreibung solltest du noch überarbeitenOption Explicit
Dim ZeileGewaehlt As Long
Sub ClearTextbox2to8()
Dim Tb As Integer
On Error Resume Next
For Tb = 2 To 8
Me.Controls("TextBox" & Tb) = ""
Next Tb
End Sub
Sub Textboxenfuellen(Zeile As Long)
With Worksheets("Tabelle 1")
TextBox2 = .Cells(Zeile, 2)
TextBox3 = .Cells(Zeile, 3)
TextBox4 = .Cells(Zeile, 4)
TextBox5 = .Cells(Zeile, 5)
TextBox6 = .Cells(Zeile, 6)
TextBox7 = .Cells(Zeile, 7)
TextBox8 = .Cells(Zeile, 8)
End With
End Sub
Sub Werteeintragen(Zeile)
If Zeile = 0 Then Exit Sub
With Worksheets("Tabelle 1")
.Cells(Zeile, 2) = TextBox2
.Cells(Zeile, 3) = TextBox3
.Cells(Zeile, 4) = TextBox4
.Cells(Zeile, 5) = TextBox5
.Cells(Zeile, 6) = TextBox6
.Cells(Zeile, 7) = TextBox7
.Cells(Zeile, 8) = TextBox8
End With
End Sub
Private Sub CommandButton1_Click()
Call Werteeintragen(ZeileGewaehlt)
End Sub
Private Sub CommandButton2_Click()
With Worksheets("Tabelle 1")
ZeileGewaehlt = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
Call Werteeintragen(ZeileGewaehlt)
End With
End Sub
Private Sub CommandButton3_Click()
Dim Tb As Integer
On Error Resume Next
For Tb = 1 To 8
Me.Controls("TextBox" & Tb) = ""
Next Tb
End Sub
Private Sub TextBox1_Change()
Dim Zelle As Range
With Worksheets("Tabelle 1")
Set Zelle = .Columns(2).Find(What:=TextBox1, lookat:=xlWhole, LookIn:=xlValues)
If Zelle Is Nothing Then
ZeileGewaehlt = 0
ClearTextbox2to8
Else
ZeileGewaehlt = Zelle.Row
Call Textboxenfuellen(ZeileGewaehlt)
End If
End With
End Sub
Private Sub TextBox6_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox6.Value = Format(TextBox6.Value, "#,##0.00 SFR")
End Sub