Code läuft unter Excel 9 nur teilweise
06.12.2005 12:30:43
Robert
ich habe mit meinen bescheidenen VBA-Kenntnissen eine Userform mit einer selbstkreierten "DB" gemacht. Es geht alles einwandfrei, aber unter Excel 9 bringt die Eingabe im Feld 'Artikelnummer' nicht den gewünschten Zugriff auf die DB-Tabelle. Auf Gut-Deutsch geschieht nichts, wenn ich etwas ins Feld eintrage. Normalerweise würden die Feldinhalte sofort in den entsprechenden Textboxen erscheinen. Außerdem bricht das Programm ab, wenn man auf 'Anlegen/Ändern' klickt.
Könnte mir bitte jemand erklären, woran das liegt und wie man das Problem beheben kann? Ich gehe davon aus, daß das 2. Problem aus dem Ersten resultiert, trotzdem habe ich's auch mit hier reinkopiert. Die Datei kann ich leider nicht hochgeladen, da sie zu groß ist. Deshalb nur die betreffenden Ausschnitte:
========================================================
Private Sub Artikelnummer_Change()
Dim ArN
ArN = Artikelnummer.Value
If ArN = "" Then
Zeile_1.Value = ""
Zeile_2.Value = ""
Preis_Euro.Value = 0
Preis_Cent.Value = 0
VOL.Value = 0
Inhalt.Value = 0
ComboBox1.Value = ""
Pfand.Value = ""
Exit Sub
End If
Worksheets("Datenbank").Activate
Columns("A:A").Select
On Error GoTo Nullen
Selection.Find(What:=ArN, After:=ActiveCell, LookIn:=xlValues, lookat:= _
xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Cells(ActiveCell.Row, ActiveCell.Column + 1).Select
ACV1 = ActiveCell.Value
Zeile_1.Value = ACV1
Cells(ActiveCell.Row, ActiveCell.Column + 1).Select
ACV2 = ActiveCell.Value
Zeile_2.Value = ACV2
Cells(ActiveCell.Row, ActiveCell.Column + 1).Select
ACV3 = ActiveCell.Value
Preis_Euro.Value = ACV3
Cells(ActiveCell.Row, ActiveCell.Column + 1).Select
ACV4 = ActiveCell.Value
Preis_Cent.Value = ACV4
Cells(ActiveCell.Row, ActiveCell.Column + 1).Select
ACV5 = ActiveCell.Value
VOL.Value = ACV5
Cells(ActiveCell.Row, ActiveCell.Column + 1).Select
ACV6 = ActiveCell.Value
Inhalt.Value = ACV6
Cells(ActiveCell.Row, ActiveCell.Column + 1).Select
ACV7 = ActiveCell.Value
ComboBox1.Value = ACV7
Cells(ActiveCell.Row, ActiveCell.Column + 1).Select
ACV8 = ActiveCell.Value
Pfand.Value = ACV8
GoTo Ende
Nullen:
Zeile_1.Value = ""
Zeile_2.Value = ""
Preis_Euro.Value = 0
Preis_Cent.Value = 0
VOL.Value = 0
Inhalt.Value = 0
ComboBox1.Value = ""
Pfand.Value = ""
Ende:
End Sub
==================================================================
'Die Prozedur zum Ändern/Speichern
Private Sub Speichern_Ändern_Click()
'Datensätze zählen
Worksheets("Datenbank").Activate
Dim ZNr As String
ZNr = [A10000].End(xlUp).Row 'Zeilennummer der letzten gefüllten Zelle
'_____________________________
'Fehler abfangen - Anfang
If ZNr = 9999 Then GoTo E9999
Dim ArNr
Dim TXT_1
ArNr = Artikelnummer.Value
Select Case ArNr
Case Is = ""
GoTo FehlerArtNrLeer
Case Is = 0
GoTo FehlerArtNrNul
End Select
TXT_1 = Zeile_1.Value
Select Case TXT_1
Case Is = ""
GoTo FehlerText1Leer
End Select
If Preis_Euro.Value = "" Then GoTo E2_Euro
If Preis_Euro > 999 Then GoTo Error_Euro
If Preis_Cent = "" Then GoTo E2_Cent
If Preis_Cent > 99 Then GoTo Error_Cent
If VOL = "" Then GoTo E2_VOL
If VOL >= 100 Then GoTo Error_Vol
If Inhalt.Value = "" Then GoTo Error_Inhalt
'Fehler abfangen - Ende
'_____________________________
Range("A2:A10000").Select
On Error GoTo Speichern 'und sonst ändert es nach dem Suchen die vorhandenen Werte
Selection.Find(What:=ArNr, After:=ActiveCell, LookIn:=xlValues, lookat:= _
xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
GoTo Aendern
'_____________________________
Speichern:
Range("A10000").Select
ActiveCell.Value = Artikelnummer.Value
Aendern:
Cells(ActiveCell.Row, ActiveCell.Column + 1).Select
ActiveCell.Value = Zeile_1.Value
Cells(ActiveCell.Row, ActiveCell.Column + 1).Select
ActiveCell.Value = Zeile_2.Value
Cells(ActiveCell.Row, ActiveCell.Column + 1).Select
ActiveCell.Value = Preis_Euro.Value
Cells(ActiveCell.Row, ActiveCell.Column + 1).Select
ActiveCell.Value = Preis_Cent.Value
Cells(ActiveCell.Row, ActiveCell.Column + 1).Select
ActiveCell.Value = VOL.Value
Cells(ActiveCell.Row, ActiveCell.Column + 1).Select
ActiveCell.Value = Inhalt.Value
Cells(ActiveCell.Row, ActiveCell.Column + 1).Select
ActiveCell.Value = ComboBox1.Value
Cells(ActiveCell.Row, ActiveCell.Column + 1).Select
ActiveCell.Value = Pfand.Value
'noch sortieren - für den Fall, daß etwas neu angelegt wurde!
Range("A2:I10000").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select
'Speichern
ThisWorkbook.Save
GoTo Ende
'_________________________________
'Fehlerbehandlung - Anfang
E9999:
MsgBox "Ihre Datenbank ist voll!" & Chr(13) & "Bitte löschen Sie erst" & "überflüssige Datensätze!", vbCritical, Warnung
With Artikelnummer
.SetFocus: .SelStart = 0: .SelLength = Len(.Text)
End With
Exit Sub
E2_Euro:
MsgBox "Ein numerisches Feld darf nicht leer sein!", vbCritical, Warnung
With Preis_Euro
.SetFocus: .SelStart = 0: .SelLength = Len(.Text)
End With
Exit Sub
E2_Cent:
MsgBox "Ein numerisches Feld darf nicht leer sein!", vbCritical, Warnung
With Preis_Cent
.SetFocus: .SelStart = 0: .SelLength = Len(.Text)
End With
Exit Sub
E2_VOL:
MsgBox "Ein numerisches Feld darf nicht leer sein!", vbCritical, Warnung
With VOL
.SetFocus: .SelStart = 0: .SelLength = Len(.Text)
End With
Exit Sub
FehlerArtNrLeer:
MsgBox "Nichts ins Feld <Artikelnummer> eingetragen!"
With Artikelnummer
.SetFocus: .SelStart = 0: .SelLength = Len(.Text)
End With
Exit Sub
FehlerArtNrNul:
MsgBox "<0> ist keine Artikelnummer!"
With Artikelnummer
.SetFocus: .SelStart = 0: .SelLength = Len(.Text)
End With
Exit Sub
FehlerText1Leer:
MsgBox "Text in Zeile 1 fehlt!"
With Zeile_1
.SetFocus: .SelStart = 0: .SelLength = Len(.Text)
End With
Exit Sub
Error_Euro:
MsgBox "Maximum 999 Euro können Sie eingeben!", vbCritical, Warnung
With Preis_Euro
.SetFocus: .SelStart = 0: .SelLength = Len(.Text)
End With
Exit Sub
Error_Cent:
MsgBox "Maximum 99 Cent können Sie eingeben!", vbCritical, Warnung
With Preis_Cent
.SetFocus: .SelStart = 0: .SelLength = Len(.Text)
End With
Exit Sub
Error_Vol:
MsgBox "Das wäre doch etwas" & Chr(13) & " für Alkoholpuristen!", vbCritical, Warnung
With VOL
.SetFocus: .SelStart = 0: .SelLength = Len(.Text)
End With
Exit Sub
Error_Inhalt:
MsgBox "Sie haben nichts ins Feld 'Inhalt' eingegeben!", vbCritical, Warnung
With Inhalt
.SetFocus: .SelStart = 0: .SelLength = Len(.Text)
End With
Exit Sub
'Fehlerbehandlung - Ende
'_________________________________
Ende:
Range("A2:A10000").Select
Selection.Find(What:=ArNr, After:=ActiveCell, LookIn:=xlValues, lookat:= _
xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
With Artikelnummer
.SetFocus: .SelStart = 0: .SelLength = Len(.Text)
End With
End Sub
========================================================
Einmal habt Ihr mir schon geholfen, das war super! Das Programm ist über 800kb und läuft unter Excel 10 einwandfrei. Die ganzen Infos dazu habe ich hier zusammen gesucht. Vielen Dank!
Und vielen Dank im voraus!
Grüße
Robert