Zeitmakro plus Zellabfrage

[Peggymaus]

Hallo Stefan,

calculate geht doch glaube ich nur für Änderungen vom ganzen Tabellenblatt, oder?

Die Vorlage soll sich nur öffnen, wenn sich d1 auf 1 stellt.

Wenn ich falsch liege... wo müsste ich was denn dann einbauen?

LG.

Peggy

PS. Bin halt VBA-Laie... Sorry.

[Steffl]

Hallo Peggy,

calculate geht doch glaube ich nur für Änderungen vom ganzen Tabellenblatt, oder?

Calculate wird ausgelöst, wenn sich ein Formelergebnis ändert.

[Peggymaus]

Hallo Stefan,

okay.... und wie würdest Du das dann in meinem Fall einbauen?

Hab da echt keinen Plan.

LG.

Peggy

[Steffl]

Hallo Peggy,

vielleicht so?

Code:

Private Sub Worksheet_Calculate()

   If Cells(1, 4).Value <> curWert Then
      Call Vorlageöffnen
      curWert = Cells(1, 3).Value
   End If
End Sub

[Peggymaus]

Hallo Stefan,

habe es ausprobiert. Die Vorlage öffnet sich nicht mehr, aber das Makro läuft auch nicht mehr,
wenn in D1 aus der 0 eine 1 wird.

Habe den Code hinter dem Tabellenblatt hinterlegt. War doch so richtig, oder?



LG.
Peggy

[Steffl]

Hallo Peggy,

könntest Du die Datei hier hochladen?

[schauan]

Hallöchen,

das hängt doch damit zusammen, oder nicht?

http://www.clever-excel-forum.de/thread-...#pid112945

Wenn Du darauf reagieren willst, dass in D1 eine 1 steht, warum vergleichst Du dann D1 mit curWert und nicht mit 1 ? curWert ändert sich ja laufend durch Deine Zeitänderung in C1 ...

[Peggymaus]

Hallo,

hier wie gewünscht meine beiden Dateien als Anlage.

LG.

Peggy

[schauan]

Hallöchen,

um mit Deinen Dateien arbeiten zu können, solltest Du auch den Blattschutz weglassen. Ansonsten bekommt man zwar das eine oder andere auf (legalen) Umwegen, aber da könnte es schon zu spät sein - siehe weiter unten ..

Deine Formel in D1 ist
=WENN(B5="";0;WENN(TAG(A5)<>TAG(LINKS(C1;8));1;0))

Hier steckt eventuell ein Fehler:
WENN(B5=""
In B5 stand bei mir nix. Bis ich darauf gekommen bin, dort etwas einzutragen, hatte Dein Zeitmakro schon das aktuelle Datum in C1 eingetragen und der in der Formel folgende Vergleich führt dazu, dass die Tage gleich sind und somit die 0 bleibt. Und dann passierte eben nix mehr, könnte also die Ursache sein.

Ich habe dann in C1 aus dem 11.03. den 10.03. gemacht und schon hat es die Datei als 09.03.... gespeichert und wollte die Vorlage öffnen - hat sie erst mal nicht gefunden, liegt bei mir ja noch unter Downloads ...

Ich bleibe aber bei meinem Vorschlag vom anderen Thread und zitiere mich mal daraus:

Für die Sache mit der 1 in D1 wäre noch die Frage, wie die wieder raus kommt. Sollte das eventuell das Makro beim ersten Speichern machen, oder hast Du da eine Formel drin die den Dateinamen auswertet? Wäre auch nicht verkehrt.

Das mit dem Dateinamen würde natürlich nur dann funktionieren, wenn Du in der Datei mit dem Datum im Namen bist und nicht in der Vorlage.

Ansonsten - das mit dem Speichern würde aber im Prinzip funktionieren. Du musst nur an irgendeine Stelle fix das Speicherdatum ablegen und vergleichst dann das aktuelle Datum mit dem in der Zelle gespeicherten und nicht mit dem Datum von C1. Beim Speichern tust Du dann den Zellinhalt mit dem neuen Datum überschreiben.

[Peggymaus]

Hallo André,

vielen Dank für Deine Ausführungen.

In Zelle D1 ist so lange eine 0 drinnen, bis das erste Mal in B5 was eingetragen wird.
Ab B5 werden nach unten Barcodes eingelesen, für die in der Spalte A Datum und Uhrzeit des Einlesens protokolliert
werden.

Die Formel in D1

=WENN(B5="";0;WENN(TAG(A5)<>TAG(LINKS(C1;8));1;0))

wurde deshalb so gewählt, dass er erst die Tage vergleicht, wenn in B5 auch ein Wert steht. Wenn die leere Vorlage
geöffnet wird, ist sonst D1 immer 1 und dass soll nicht sein.

Sub Vorlageöffnen()
'
' Vorlageöffnen Makro
'
   If Range("D1").Value = 0 Then 'Wenn D1 = 0
   
   Dim myPath, myFileName As String
   myPath = ThisWorkbook.Path
   'myFileName = Range("d2") & ".xlsm" 'dann erstelle aus D2 und der Endung xlsm einen Dateinamen und speier diesen ab
   myFileName = Format(Range("d2"), "dd.mm.yyyy")
   Application.DisplayAlerts = False
   ActiveWorkbook.SaveAs myPath & "\" & myFileName
   Application.DisplayAlerts = True
   Else
   myPath = ThisWorkbook.Path 'Wenn D1 ungleich 0, dann speicher die Datei nochmal unter dem Datum vom Vortag (D3), Öffne dann die Vorlage und speichere diese unter dem neuen Datum (D2) ab
   myFileName = Format(Range("d3"), "dd.mm.yyyy") & ".xlsm"
   Application.DisplayAlerts = False
   ActiveWorkbook.SaveAs myPath & "\" & myFileName
   Application.DisplayAlerts = True
   Workbooks.Open Filename:="D:\ Dokumente\FUCHS\Vorlage.xlsm"
   Sheets("Tabelle1").Select
   Range("B5").Select
   myPath = ThisWorkbook.Path
   myFileName = Range("d2") & ".xlsm"
   Application.DisplayAlerts = False
   ActiveWorkbook.SaveAs myPath & "\" & myFileName
   Windows(Range("d3") & ".xlsm").Activate 'Aktiviere noch einmal die Datei vom Vortag (D3)
   ActiveSheet.Unprotect "123"
   Range("D1").Select
   ActiveCell.FormulaR1C1 = "0" 'Gib in D1 eine 0 ein, damit beim späteren Öffnen der Datei kein Vergleich mehr stattfindet
   Range("D2").Select
   ActiveSheet.Protect "123"
   ActiveWorkbook.Save 'Speichere die Datei vom Vortag (D3)und schließe sie.
   ActiveWindow.Close
   Range("B5").Select 'Kehre zur aktuellen Datei zurück
   Application.DisplayAlerts = True
End If
End Sub


So und der folgende Code:

Private Sub Worksheet_Change(ByVal Target As Range)
  ThisWorkbook.Worksheets("Tabelle1").Unprotect "123"
  Application.ScreenUpdating = False
  If Not (Intersect(Range("B:B"), Target) Is Nothing) Then Target.Offset(0, -1) = Now()  'Hier soll bei
Eintrag in Spalte B die dazugehörige Zelle in Spalte A mit Datum und Uhrzeit (Protokollierung) versehen werden
  Application.ScreenUpdating = True
  ThisWorkbook.Worksheets("Tabelle1").Protect "123"
 
  If Cells(1, 4).Value <> curWert Then 'Tja und hier soll die Abfrage stattfinden, dass wenn in D1 eine 1 steht automatisch das Makro Vorlageöffnen gestartet wird
      Call Vorlageöffnen
   curWert = Cells(1, 3).Value
  End If

End Sub

Hoffe jetzt ist meine Datei verständlicher.

LG.

Peggy