Hallo liebes Forum,
vielleicht könnt ihr mir hier weiterhelfen.
Wenn ich jetzt eine Zelle "Tag" ändere und sich die Zelle mit der Kalenderwoche ändert, möchte ich dass sich dann das Fenster "SpeichernUnter" öffnet.
Mit diesem Code, funktioniert es nur wenn ich manuell die Zelle ändere. Jedoch soll sich das Fenster "SpeichernUnter" öffnen wenn die Zelle "Tag" geändert wird, daraufhin sich die Zelle mit der "Kalenderwoche" erhöht.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Application.Intersect(Target, Range("$J$8"))
If Target Is Nothing Then Exit Sub
Application.Dialogs(xlDialogSaveAs).Show
End Sub
Bin für alle Anregungen dankbar
claudia
Hallo Claudia,
ich als "Nichtprofi" würde das mit einem Makro in "Diese Arbeitsmappe" lösen.
Code:
Option Explicit
Private Sub Workbook_Open()
If Sheets("Tabelle1").Range("$J$8") <> Sheets("Tabelle2").Range("A1") Then
Sheets("Tabelle2").Range("A1") = Sheets("Tabelle1").Range("$J$8")
Application.Dialogs(xlDialogSaveAs).Show
End If
End Sub
Voraussetzung ist hier allerdings, dass in der Zelle "Sheets("Tabelle1").Range("$J$8")" die Formel =heute() hinterlegt wurde. Ein Vergleichsdatum liegt in Sheets("Tabelle2").Range("A1")
Gruß
Marcus
Hallo Claudia,
wenn Du die KW aus dem einzugebenden Datum berechnest, ist die Sache in Excel etwas knifflig. Das Problem ist, dass die Berechnung der KW zuerst erfolgt und dann die Ereignismakros greifen. Ist nicht ganz so clever, ist aber leider so
Excel muss sich also erst einmal den Wert der Zelle merken, bevor Du loslegen kannst.
Ich habe das in einem Ereignismakro beim Aktivieren des Blattes untergebracht. Mit diesem Wert wird dann die KW des geänderten Datums verglichen. Übrigens - das geht auch einfacher. Eigentlich brauchst DU nur den in der Variable gespeicherten Wert mit dem aktuellen Wert von A1 vergleichen. Ich sagte ja gerade - erst wird gerechnet, dann greifen die Ereignismakros
Die Funktion für die Kalenderwoche hab ich trotzdem mal eingebaut, zur Info, wenn die mal jemand wirklich braucht. Man findet die Zuhauf im Internet, da Excel in älteren Versionen mit Bordmitteln nicht richtig gerechnet hatte.
Übrigens mal noch zwei Hinweise:
In meinem Beispiel hab ich die Zellen A1 und B1 genommen, die musst Du auf Deine Aufgabe anpassen.
Wenn man aus dem Blatt in den VBA-Editor wechselt oder z.B. in den Entwicklertools Objekte einfügt, kann es passieren, dass die Variable geleert wird. Sicherer wäre, falls so was während der Arbeit passieren kann, den Wert aus A1 in einer ungenutzten Zelle abzulegen.
Code:
Option Explicit
'Variablendekalration
Dim iA1 As Integer
Private Sub Worksheet_Activate()
'Zellwert aus A1 bei Aktivierung des Blattes uebernehmen
iA1 = Range("A1").Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'Schnittstelle zwischen Selection und Datumszelle setzen
Set Target = Application.Intersect(Target, Range("$b$1"))
'Wenn keine Schnittstelle vorhanden, dann Makro verlassen
If Target Is Nothing Then Exit Sub
'Wenn die KW vom Datum verschiedne der gespeicherten KW ist, dann Dialog aufrufen
If DINKw(Range("b1").Value) <> iA1 Then Application.Dialogs(xlDialogSaveAs).Show
'Neuen KW-Wert uebernehmen
iA1 = Range("A1").Value
End Sub
Public Function DINKw(Datum As Date) As Integer
'Variablendeklaration
Dim lngT As Long
'Datumswert des uebergebenen Datums ermitteln
lngT = DateSerial(Year(Datum + (8 - Weekday(Datum)) Mod 7 - 3), 1, 1)
'KW aus Datumswert berechnen
DINKw = ((Datum - lngT - 3 + (Weekday(lngT) + 1) Mod 7)) \ 7 + 1
End Function
@marose67
Danke dir erstmal für deine Hilfe. Bei deiner Lösung ist es ebenfalls so, dass sich SpeichernUnter öffnet, wenn mann die Zelle manuell ändert.
@schauan
Auch dir vielen lieben Dank. Ich habe jetzt eine andere und wie ich finde etwas einfache Lösung zu meinem Problem. Habe jetzt in DieseArbeitsmappe den Code so geschrieben dass er sich den alten Wert merkt sobald die Datei geöffnet wird. Weiterhin wird dann verglichen ob sich die "KW" erhöht durch Änderung der Zelle
"Tag" oder auch "Monat" was keine Rolle spielt, dann das Fenster mit "SpeichernUnter" öffnet
Ich schreib mal den Code hier rein für andere, die evtl. auch danach suchen.
<><><>DieseArbeitsmappe<><><>
Code:
Option Explicit
Public altWert
Private Sub Workbook_Open()
altWert = Tabelle3.Range("J8")
End Sub
<><><>MeineTabelle<><><><>
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If DieseArbeitsmappe.altWert <> Range("J8") Then
Application.FileDialog(msoFileDialogSaveAs).Show
DieseArbeitsmappe.altWert = Range("J8")
End If
End Sub