MSG Box wenn neue Eingabe erfolgt

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Public TargetWert# Private Sub Worksheet_SelectionChange(ByVal Target As Range) TargetWert = Target.Value End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim sFrage$ Application.EnableEvents = False If Not Intersect(Target, Range("q2:q1000")) Is Nothing And Target.Count = 1 Then If Target.Value = "" Then Target.Offset(, 1).ClearContents Else Target.Offset(, 1) = Now If Target.Value TargetWert Then sFrage = MsgBox("Ändern?", vbYesNoCancel + vbQuestion, "Änderung übernehmen?") _ If sFrage = vbNo Then Target.Value = TargetWert Target.Offset(, 1).ClearContents End If End If End If End If Application.EnableEvents = True End Sub

Public Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Bereich As Range Set Bereich = Range("d2:d500") If Not Intersect(Target, Bereich) Is Nothing Then Application.Dialogs(xlDialogOpen).Show "\\CMBvedi\Daten\08_Qualität\" & Target & "\" End If End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Dim sFrage$ Application.EnableEvents = False If Not Intersect(Target, Range("q2:q1000")) Is Nothing And Target.Count = 1 Then If Target.Value = "" Then Target.Offset(, 1).ClearContents Else Target.Offset(, 1) = Now If Target.Value TargetWert Then sFrage = MsgBox("Ändern?", vbYesNoCancel + vbQuestion, "Änderung übernehmen?") _ _ If sFrage = vbNo Then Target.Value = TargetWert Target.Offset(, 1).ClearContents End If End If End If End If Application.EnableEvents = True End Sub

Hallo Hartmut,
irgendwie schreibst du wirres Zeug! Wie willst Du mit einem " Application.Dialogs(xlDialogOpen).Show"-Befehl eine Datei in einen Ordner legen? Damit kannst du eine Datei öffnen, aber nicht schließen!
In deinem ersten Post hast du folgendes geschrieben:
"ich möchte das wenn der Wert in "Q" gelöscht wird das auch der Wert in "R" gelöscht wird. Sollte allerdings der Wert sich nur ändern, dann soll per Message Box eine Auswahl gegeben werden. Ändern "Ja", Nicht Ändern "Nein", oder "Abbrechen"."
Doch dazu brauchst du den "Private Sub Worksheet_Change(ByVal Target As Range)"-Ereignis-Code. Nur mit "Selection_Change" geht das nicht, denn ohne den "Private Sub Worksheet_Change"-Ereignis-Code kannst du ja nicht auswählen, ob du einen geänderten Wert übernehmen willst oder nicht.
Also, was willst du nun tun?
Servus

Hi Herbert,
sorry wenn das verwirrend herüber kommt. Das macht wohl das fehlende Fachwissen für diese Materie.
Hier ist der komplette Code von meinem kleinen Tool.
Ich denke das es alles vereinfacht. Ich habe gedacht es reicht wenn ich nur den Auszug eintrage von den störenden Elementen.
Nun gut hier ist der Code.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fehler
Dim Pfad$, Ordner$, FS, Mfile1$, Mfile2$, Mfile3$, Mfile4$, SP%, ZE%, DN%, Letzter%
SP = 6 'Eintragungen in Spalte 6 werden zum generieren verwendet
ZE = 2 'Ab Zeile 2 werden eintragungen vorgenommen
If Not Intersect(Target, Columns(SP)) Is Nothing And Target.Row >= ZE Then
If Target.Offset(-1, 0)  "" Then  'prüfen ob kein Eintrag vorhanden ist
Set FS = CreateObject("Scripting.FileSystemObject")
Pfad = "\\CMB\8.24_Material\_TKIS\"
Mfile1 = "\Testsheet1.xlsx"
Mfile2 = "\Testsheet2.xlsx"
DN = 4
Letzter = IIf(Target.Row = ZE, 0, Right(Cells(Target.Row - 1, DN).Value, 3)) ' _
Letzte Ordner
Ordner = Format(Letzter + 1, """MRR-E&I_""000")
Application.EnableEvents = False
Cells(Target.Row, DN).Value = Ordner
Application.EnableEvents = True
If Dir(Pfad & Ordner, vbDirectory) = "" Then
MkDir Pfad & Ordner
FS.copyfile Pfad & Mfile1, Pfad & Ordner & Mfile1, True
FS.copyfile Pfad & Mfile2, Pfad & Ordner & Mfile2, True
MsgBox "Ordner angelegt" & vbLf & vbLf & "und Sheets eingefügt"
Else
MsgBox "Ordner existiert bereits"
End If
Else
MsgBox "Leerzeile vorher darf nicht sein"
End If
End If
Err.Clear
Fehler:
If Err.Number  0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
Application.EnableEvents = True
If Not Intersect(Target, Range("o2:o1000")) Is Nothing And Target.Count = 1 Then
Target.Offset(, 1) = Now
End If
If Not Intersect(Target, Range("q2:q1000")) Is Nothing And Target.Count = 1 Then
Target.Offset(, 1) = Now
End If
'If Not Intersect(Target, Range("t5:t12000")) Is Nothing And Target.Count = 1 Then
'Target.Offset(, 1) = Now
'End If
'If Not Intersect(Target, Range("v5:v12000")) Is Nothing And Target.Count = 1 Then
'Target.Offset(, 1) = Now
'End If
End Sub

Public Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Bereich As Range
Set Bereich = Range("d2:d500")
If Not Intersect(Target, Bereich) Is Nothing Then
Application.Dialogs(xlDialogOpen).Show "\\CMB\8.24_Material\_TKIS\\" & Target & "\"
End If
End Sub

Das ist jetzt der komplette Code ohne deinen Zusatz/Änderung.
Vielen Dank schon jetzt für deine tolle Unterstützung.
Gruß
Hartmut

Beliebteste Forumthreads (12 Monate)

MSG Box wenn neue Eingabe erfolgt

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread