Sicherheitsabfrage an Bediener

Hallo,
Heute morgen habe ich schon mal gepostet, ohne eine Beispieldatei angegeben zu haben, deswegen versuche ich es noch einmal. Vielen Dank für Euer Verständnis.
Es geht um eine Tabelle in der Artikelbestände erfaßt werden.
Spalte 4 enthält den aktuellen Bestand.
In Spalte 7 wird die Entnahmemenge eingetragen. Der Bestand in Spalte 4 verringert sich um die eingetragene Entnahmemenge. In Spalte 8 wird das Datum, der letzten Entnahme eingetragen.
Das heißt, der Bestand subtrahiert den in Spalte 7 eingetragenen Wert von sich selber.
Zum Problem wird es erst, wenn ein Benutzer einen falschen Wert in Spalte 7 einträgt (z.B. 100 entnommene Einheiten), mit RETURN bestätigt, seinen Fehler ohne Nachzudenken in Nachhinein korrigieren will und den korrekten Wert einträgt (z.B. 120 entnommene Einheiten), wieder bestätigt, wird der Wert in Spalte 1 erneut abgezogen und der aktuell eingetragene Bestand ist nicht der richtige (Weil der Fehler ja auch abgezogen wurde).
Ich möchte gern eine Eingabebestätigung haben. Einen Dialog, der den Bediener abfragt: Wollen sie den Wert 100 (aus Spalte 7) für den Artikel (aus Spalte 2) wirklich eintragen (Ok Button) oder korrigieren (Abbrechen Button).
Ich hätte gern einen Button für jede Spalte, in der Entnahme- bzw. Wareneingangswerte eingetragen werden.
Leider bin ich in VBA nicht bewandert und würde mich über Vorschläge oder Code-Schnipsel freuen.
Ein weiteres Problem: Diese Liste muss öfter "reseted" werden. D.h. die Inhalte aller vom Bediener zu ändernden Spalten müssen gelöscht werden (Warenentnahme, Wareneingang), wobei die Spalten mit den Artikelbezeichnungen und dem aktuellen Bestand unberührt bleiben müssen.
Natürlich könnte man alle betroffenen Zellen markieren und Entfernen drücken. Muss ich dann für jede gelöschte Zelle eine Eingabebestätigung drücken, wenn das Problem oben behoben ist?
Ist es möglich, diesen Reset mittels eines Buttons zu realisieren (bei Drücken, lösche alle Zellen von Spalte sowieso, bis Spalte sowieso, lass aber die Kopfzeile aus)?
Vielen Dank für Eure Hilfe
Schmendrich
die Datei:
https://www.herber.de/bbs/user/23363.xls

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) Select Case Target.Column Case 7 Target.Offset(0, -3) = Target.Offset(0, -3) - Target + valTarget Target.Offset(0, 1) = Now Target.Offset(0, -2) = Target.Offset(0, -2) + Target - valTarget Case 9 Target.Offset(0, -5) = Target.Offset(0, -5) - Target + valTarget Target.Offset(0, 1) = Now Target.Offset(0, -4) = Target.Offset(0, -4) + Target - valTarget Case 11 Target.Offset(0, -7) = Target.Offset(0, -7) + Target - valTarget Target.Offset(0, 1) = Now Case 13 Target.Offset(0, -9) = Target.Offset(0, -9) + Target Target.Offset(0, 1) = Now Target.Offset(0, -8) = Target.Offset(0, -8) - Target Case 5 Target.Offset(0, 1) = Now End Select End Sub

Hallo
Vielleicht hilft dir folgender Code weiter.

Option Explicit
Dim Status    As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Antwort
' Verlassen, wenn Status = True (Reset_durchführen wird ausgeführt)
  If Status = True Then Exit Sub
On Error GoTo errHandle
  Application.EnableEvents = False
  With Target
    If .Column = 7 Then
      Antwort = MsgBox("E I N Z E L V E R K A U F" & vbCrLf & vbCrLf & _
                       "Artikel: " & .Offset(0, -5) & vbCrLf & _
                       "Anzahl: " & Target.Value & vbCrLf & vbCrLf & _
                       "Daten korrekt?", vbYesNo + vbQuestion, "Eingabe prüfen")

      If Antwort = 7 Then   'Nein wurde gedrückt
        .Select: .ClearContents
        GoTo errHandle
      End If

      .Offset(0, -3) = .Offset(0, -3) - .Value
      .Offset(0, 1) = Now
      .Offset(0, -2) = .Offset(0, -2) + .Value
    End If

    If .Column = 9 Then
      Antwort = MsgBox("A U F A R B E I T U N G" & vbCrLf & vbCrLf & _
                       "Artikel: " & .Offset(0, -7) & vbCrLf & _
                       "Anzahl: " & Target.Value & vbCrLf & vbCrLf & _
                       "Daten korrekt?", vbYesNo + vbQuestion, "Eingabe prüfen")

      If Antwort = 7 Then   'Nein wurde gedrückt
        .Select: .ClearContents
        GoTo errHandle
      End If

      .Offset(0, -5) = .Offset(0, -5) - .Value
      .Offset(0, 1) = Now
      .Offset(0, -4) = .Offset(0, -4) + .Value
    End If

  If .Column = 11 Then
      Antwort = MsgBox("W A R E N E I N G A N G" & vbCrLf & vbCrLf & _
                       "Artikel: " & .Offset(0, -9) & vbCrLf & _
                       "Anzahl: " & Target.Value & vbCrLf & vbCrLf & _
                       "Daten korrekt?", vbYesNo + vbQuestion, "Einzelverkauf prüfen")

      If Antwort = 7 Then   'Nein wurde gedrückt
        .Select: .ClearContents
        GoTo errHandle
      End If

    .Offset(0, -7) = .Offset(0, -7) + .Value
    .Offset(0, 1) = Now
  End If

  If .Column = 13 Then
      Antwort = MsgBox("R Ü C K G A B E" & vbCrLf & vbCrLf & _
                       "Artikel: " & .Offset(0, -11) & vbCrLf & _
                       "Anzahl: " & Target.Value & vbCrLf & vbCrLf & _
                       "Daten korrekt?", vbYesNo + vbQuestion, "Eingabe prüfen")

      If Antwort = 7 Then   'Nein wurde gedrückt
        .Select: .ClearContents
        GoTo errHandle
      End If

    .Offset(0, -9) = .Offset(0, -9) + .Value
    .Offset(0, 1) = Now
    .Offset(0, -8) = Target.Offset(0, -8) - .Value
  End If

  If Target.Column = 5 Then Target.Offset(0, 1) = Now
  End With
errHandle:
  Application.EnableEvents = True
End Sub
Sub Reset_durchführen()
Dim lezZeile      As Long
Dim löschBereich  As Range
' Verhindert das Abarbeiten von Worksheet_Change
  Status = True
' letzte Datenzeile der Spalte 'D' ermitteln
  lezZeile = letzteZeile("AUA_Einzelverkauf", 4)

' der zu löschende Bereich
  Set löschBereich = Range("E3:M" & lezZeile)

'Bereich löschen, Formatierung behalten
  löschBereich.ClearContents

' Worksheet_Change wieder abarbeiten
  Status = False
End Sub
Public Function letzteZeile(vWS As Variant, Optional X As Long = 1) As Long
Dim Y   As Long
Dim ws  As Worksheet

  On Error GoTo PROC_ERR

  Select Case UCase(TypeName(vWS))
    Case "STRING"
      Set ws = Worksheets(vWS)
    Case "WORKSHEET"
      Set ws = vWS
    Case Else
      GoTo PROC_ERR
  End Select

  With ws
    Y = .Rows.Count
    letzteZeile = .Cells(Y, X).End(xlUp).Row
  End With

PROC_EXIT:
  Exit Function
PROC_ERR:
  letzteZeile = -1
  Resume PROC_EXIT
End Function

Bei weiteren Fragen einfach melden.
mfg, GraFri

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread