AW: @Lukas "Datenbank" - Code Korrekturen
03.06.2016 17:48:02
Piet
Hallo Lukas
ich habe beim Testen noch ein paar Flüchtigkeitsfehler bemerkt. Bitte korrigiere sie.
Fehler Korrekturen: - UserForm2 Code
Private Sub CommandButton4_Click() - ist falsch! Button 4 ist für Rules laden bestimmt
Private Sub CommandButton3_Click() - So ist es richtig! Button 3 bei Klick
DatenIn_Datenbank_Löschen
Korrektur: ListBoxNotiz_laden
Private Sub ListBox1_Click() - Vor "Notiz laden" noch diese If Anweisung einfügen (beide UFs)
If UserForm2.ListBox1.ListIndex
ListBox_Notiz_laden
Korrektur für Daten Löschen: - If Indx -1 Then funktioniert nicht einwandfrei!! Besser so:
If Indx
neue Idee:
Mir kam der Gedanke beim Daten löschen, Was ist wenn es schon eine DB Notiz gibt?
Das bisherige Programm überschreibt existierende Notiz oder Version nicht!
Beim neuen Code kommt eine Abfrage ob du eine seperate Notiz in Spalte I speichern willst?
Die alte DB Notiz bleibt davon unberüht, sie wird nicht überschrieben!
Ich hoffe das ich jetzt alle Flüchtigkeitsfehler gefunden habe.
mfg Piet
neuer Code für Daten Löschen mit InputBox Abfrage:
Option Explicit '03.6.2016 Piet für Herber Forum
Dim DBWb As Object, DBLö As Object
Dim rFind As Object, AC As Object
Dim Rules As String, Txt As String
Dim Notiz As String, Version As String
Dim Artikel As Variant, Indx As Integer
'Makro löscht Artikel Daten in der Datenbank
'Daten werden inn "gelöschte Daten" kopiert
'*** neuer Code mit InpuBox Abfrage für seperate Lösch Notiz
Sub DatenIn_Datenbank_Löschen()
Dim DbZeile As Long, lZell As Long
Dim bZahl As Double, löZell As Long
Dim Zahl As Double 'nachgetragen 2.6.2016 (AW von Lukas)
Dim LöschNotiz As String 'neu hinzugefügt 3.6.2016
Set_UserForm 'Set UF
'Index aus ListBox1 laden
Notiz = Empty: Version = Empty
Indx = UF.ListBox1.ListIndex
'Fehlermeldung mit Abfrage bei: Breite/Länge/Höhe (Gewichİt)
If Indx = 0 Then
Artikel = UF.ListBox1.Value
Rules = UF.ListBox1.List(Indx, 6)
If UF.TextBox1 "Notiz:" Then Notiz = UF.TextBox1
If UF.TextBox2 "Vers:" Then Version = UF.TextBox2
End If
Set DBWb = Workbooks(DBDatei).Worksheets(DBBlatt)
Set DBLö = Workbooks(DBDatei).Worksheets(DBLösch)
lZell = DBWb.Cells(Cells.Rows.Count, "E").End(xlUp).Row
löZell = DBLö.Cells(Cells.Rows.Count, "E").End(xlUp).Row + 1
'SuchName auf DB Format formatieren 473.123.123
Txt = Artikel 'für Artikel mit "."
If InStr(Txt, ".") = 0 Then _
Txt = Mid(Txt, 1, 3) & "." & _
Mid(Txt, 4, 3) & "." & Mid(Txt, 7, 3)
'Vorprüfung ob Artikel in DB vorhanden ist?
For Each AC In DBWb.Range("E3:E" & lZell)
If AC.Value = CLng(Artikel) Or AC.Value = Txt Then
If DBWb.Cells(AC.Row, ("K")) = Rules Then
flg = "okay" 'Breite/ L/ Höhe vergleichen
For j = 1 To 3
Zahl = CDbl(UF.ListBox1.List(Indx, j))
If AC.Offset(0, j) Zahl Then flg = "No"
Next j
If flg = "okay" Then DbZeile = AC.Row: Exit For
End If
End If
Next AC
'Fehlermeldung wenn Artikel nicht gefunden wurde
If flg = "No" Then MsgBox Artikel & " Artikel: - in Datenbank nicht gefunden!": Exit Sub
'Sicherheits Abfrage ob Artikel gelöscht werden soll
ok = MsgBox("Soll Artikel: " & Artikel & " wirklich gelöscht werden ? ", vbOKCancel)
If ok = vbCancel Then Exit Sub
'Daten in Blatt "gelöschte Daten" kopieren
Zahl = DBLö.Cells(Cells.Rows.Count, "A").End(xlUp)
DBWb.Cells(DbZeile, 2).Resize(1, 12).Copy _
DBLö.Cells(löZell, 2) 'direkt kopieren
'Datum und Lauf Nr hinzufügen (gelöschte Daten)
DBLö.Cells(löZell, 2).Value = Now
DBLö.Cells(löZell, 1).Value = Zahl + 1
'Notiz und Version nur wenn Zeilen leer sind
If DBLö.Cells(löZell, 4) = Empty And _
Notiz "" Then DBLö.Cells(löZell, 4) = Notiz
If DBLö.Cells(löZell, 3) = Empty And _
Version "" Then DBLö.Cells(löZell, 3) = "'" & Version
'extra Lösch Notiz wenn Notiz in DB vorliegt
If Notiz Empty Then
LöschNotiz = InputBox("wollen Sie eine seperate Lösch-Notiz einfügen?", " Lösch Notiz ..." _
)
If LöschNotiz Empty Then DBLö.Cells(löZell, "L") = LöschNotiz
End If
'aktuelle Zeile in Datenbank löschen (mit Lauf Nr)
DBWb.Cells(DbZeile, 2).Resize(1, 12).Delete Shift:=xlUp
DBWb.Cells(lZell, 1).Value = Empty 'letzte Lauf Nr löschen
Application.CutCopyMode = False
'aktive UserForm 2/3 neu laden
If UF.Name = "UserForm2" Then Call UserForm2_neu_laden
If UF.Name = "UserForm3" Then Call UserForm3_neu_laden
End Sub
