|
Hallo,
ich habe in einer meiner Excel Dateien derzeitig ein nerviges Problem. Und zwar habe ich eine Userform geschrieben, welche die in den Textboxen eingetragenen Werte in eine Tabelle übertragen soll. Das ganze funktioniert auch einwandfrei, nur wenn ich mal 5 Einträge hintereinander einfüge, bringt er mir die Fehlermeldung "Die Methode Value für das Objekt Range ist fehlgeschlagen". Wenn ich dann das ganze debugge und den Schritt erneut ausführe, macht er ganz normal weiter, als ob kein Fehler passiert wäre. Danach kommt der Fehler bei jedem weiteren Eintrag. Nur wenn ich die Userform neu starte, kann ich wieder so um die 5 Einträge ohne Fehler machen.
Der Fehler tritt immer beim "Private Sub Hinzufügen_Click()" und der Zeile "Daten.Cells(last, 1).Value = Box_Lieferant.Value" auf.
Private Sub UserForm_Initialize()
Dim sngTop As Single, sngLeft As Single
Me.StartUpPosition = 0
sngLeft = Application.Left + Application.Width / 2 - Me.Width / 2
sngTop = Application.Top + Application.Height / 2 - Me.Height / 2
Me.Left = sngLeft
Me.Top = sngTop
Daten.Range("A2").CurrentRegion.Sort Key1:=Daten.Range("A2"), Header:=xlYes, Order1:=xlAscending
ListBox1.ColumnCount = 10
Dim lastCellList As Long
lastCellList = Daten.Cells(Rows.Count, 1).End(xlUp).Row
ListBox1.RowSource = "Daten!A1:F" & lastCellList
Übersicht.Range("BearbeitenRow").ClearContents
End Sub
Private Sub Hinzufügen_Click()
If Box_Lieferant.Value = "" Then
MsgBox "Lieferant fehlt"
Exit Sub
End If
If Box_Artikel_Art.Value = "" Then
MsgBox "Artikel Art fehlt"
Exit Sub
End If
If Box_Artikel_Bezeichnung.Value = "" Then
MsgBox "Artikel Bezeichnung fehlt"
Exit Sub
End If
If Box_Artikel_Nummer.Value = "" Then
MsgBox "Artikel Nummer fehlt"
Exit Sub
End If
If Box_Verpackungseinheit.Value = "" Then
MsgBox "Verpackungseinheitfehlt"
Exit Sub
End If
If Box_Preis.Value = "" Then
MsgBox "Preis fehlt"
Exit Sub
End If
Dim last As Integer
Dim loLetzte As Long
Dim k As Range
Dim strText As String
strText = Box_Artikel_Nummer.Value
loLetzte = Daten.Cells(Rows.Count, 4).End(xlUp).Row
last = Daten.Cells(Rows.Count, 1).End(xlUp).Row + 1
If IsEmpty(Übersicht.Range("BearbeitenRow")) Then
Else
last = Übersicht.Range("BearbeitenRow")
GoTo Bearbeiten
End If
Set k = Daten.Range("D2:D" & loLetzte).Find(strText, LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
If Not k Is Nothing Then
MsgBox "Die Artikel Nummer " & strText & " wurde bereits hinzugefügt."
Else
Bearbeiten:
Daten.Cells(last, 1).Value = Box_Lieferant.Value
Daten.Cells(last, 1).NumberFormat = "@"
Daten.Cells(last, 2).Value = Box_Artikel_Art.Value
Daten.Cells(last, 2).NumberFormat = "@"
Daten.Cells(last, 3).Value = Box_Artikel_Bezeichnung.Value
Daten.Cells(last, 3).NumberFormat = "@"
Daten.Cells(last, 4).Value = Box_Artikel_Nummer.Value
Daten.Cells(last, 4).NumberFormat = "@"
Daten.Cells(last, 5).Value = Box_Verpackungseinheit.Value
Daten.Cells(last, 5).NumberFormat = "@"
If IsNumeric(Box_Preis.Text) Then
Daten.Cells(last, 6).Value = CDbl(Box_Preis.Text)
Else
Daten.Cells(last, 6).Value = ""
End If
Daten.Range("A2").CurrentRegion.Sort Key1:=Daten.Range("A2"), Header:=xlYes, Order1:=xlAscending
End If
Übersicht.Range("BearbeitenRow").ClearContents
Dim lastCellList As Long
lastCellList = Daten.Cells(Rows.Count, 1).End(xlUp).Row
ListBox1.RowSource = "Daten!A1:F" & lastCellList
'Box_Lieferant.Value = ""
'Box_Artikel_Art.Value = ""
'Box_Artikel_Bezeichnung.Value = ""
'Box_Artikel_Nummer.Value = ""
'Box_Verpackungseinheit.Value = ""
'Box_Preis.Value = ""
Box_Lieferant.SetFocus
End Sub
Private Sub Bearbeiten_Click()
Dim i As Integer
For i = 1 To Daten.Cells(Rows.Count, 1).End(xlUp).Row - 1
If ListBox1.Selected(i) Then
SelectedRow = Daten.Rows(i + 1).Row
End If
Next i
Box_Lieferant.Value = Daten.Cells(SelectedRow, 1).Value
Box_Artikel_Art.Value = Daten.Cells(SelectedRow, 2).Value
Box_Artikel_Bezeichnung.Value = Daten.Cells(SelectedRow, 3).Value
Box_Artikel_Nummer.Value = Daten.Cells(SelectedRow, 4).Value
Box_Verpackungseinheit.Value = Daten.Cells(SelectedRow, 5).Value
Box_Preis.Value = Daten.Cells(SelectedRow, 6).Value
Übersicht.Range("BearbeitenRow").Value = SelectedRow
End Sub
Private Sub Löschen_Click()
Dim Eingabewert As Byte
Eingabewert = MsgBox("Möchten sie den Eintrag wirklich löschen?", vbYesNoCancel, "Eintrag Löschen")
If Eingabewert = vbYes Then
Dim i As Integer
For i = 1 To Daten.Range("A65356").End(xlUp).Row - 1
If ListBox1.Selected(i) Then
Daten.Rows(i + 1).Delete
End If
Next i
Übersicht.Range("BearbeitenRow").ClearContents
End If
End Sub
Private Sub Reset_Click()
Dim iControl As Control
For Each iControl In Me.Controls
If iControl.Name Like "Box*" Then iControl = vbNullString
Next
Übersicht.Range("BearbeitenRow").ClearContents
End Sub
Private Sub Abbrechen_Click()
Übersicht.Range("BearbeitenRow").ClearContents
Unload Me
End Sub
Private Sub Artikel_Art_sortieren_Click()
Daten.Range("A2").CurrentRegion.Sort Key1:=Daten.Range("B2"), Header:=xlYes, Order1:=xlAscending
End Sub
Private Sub Artikel_Bezeichnung_sortieren_Click()
Daten.Range("A2").CurrentRegion.Sort Key1:=Daten.Range("C2"), Header:=xlYes, Order1:=xlAscending
End Sub
Private Sub Lieferant_sortieren_Click()
Daten.Range("A2").CurrentRegion.Sort Key1:=Daten.Range("A2"), Header:=xlYes, Order1:=xlAscending
End Sub
Gruß Lukas
|