Zelleninhalt aus anderer Datei

[Didi]

Wochenzettel_KW_04.xls

Didi

[Steffl]

Hallo Didi,

suchst Du nicht die Woche davor? Wenn ja, versuchs mal so

Code:

Sub test()

MsgBox "Wochenzettel_KW_" & Format(Format(Date, "ww", , vbFirstFourDays) - 1, "00")
If Not GetDataClosedWB("F:\dokumente und Einstellungen\AdminUser\Dektop\eee\", _
                        "Wochenzettel_KW_" & Format(Format(Date, "ww", , vbFirstFourDays) - 1, "00"), _
                        "Tabelle1", _
                        Worksheets("Tabelle1").Range("H31"), _
                        Worksheets("Tabelle1").Range("H28")) Then _
                        MsgBox "Bitte berichtigen"
'"F:\dokumente und Einstellungen\AdminUser\Dektop\eee\", _             = Speicherpfad
'"Wochenzettel_KW_" & Format(Format(Date, "ww",,) - 1, "00"), _          = Dateiname
'"Tabelle1", _                                   vbfirstFourDays                      = Tabellenname
'Worksheets("Tabelle1").Range("H31"), _                                = aus dieser Zelle wird der Wert genommen
'Worksheets("Tabelle1").Range("H28"))                                  = in diese Zellle wird er geschrieben

'Workbooks.Open FileName "F:\dokumente und Einstellungen\AdminUser\Dektop\eee\Wochenzettel_KW_" & FORMAT(Date,"ddmmyyyy") & ".xls"
End Sub

[Didi]

Ich habe den Teil des Codes ausgetauscht und gespeichert.
die xls. habe ich kopiert damit einige Wochen im Ordner sind.

Beim ausführen kommt immer KW 02.

sowie

Die Quelldatei oder der Quellbereich ist ungültig.

Didi

[Didi]

Ist es nicht leichter eine leere Zelle nach der Kalenderwoche abzufragen, wenn die eingetragene KW die gleiche ist wie in E2 passiert nichts.
Ist die eingetragene KW nicht E2 dann H31 nach H28 verschieben und in die Zelle die KW eintragen.

Würde man die Datei kopieren passt der Eintrag nicht mit dem Dateinamen zusammen und es wird wieder verschoben.

Didi

[Steffl]

Hallo Didi,

habe bemerkt das hier die Kalenderwoche falsch berechnet wird und außerdem habe ich die Adresse falsch übergeben :s. Aber bisschen googeln hat die Lösung gebracht. Nehme mal dieses Makro

Code:

Sub test()
    Dim intKW As Integer
    
    intKW = KALENDERWOCHE_DIN(Date)
    
    MsgBox "Wochenzettel_KW_" & Format(intKW - 1, "00")
    If Not GetDataClosedWB(ThisWorkbook.Path, _
                            "Wochenzettel_KW_" & Format(intKW - 1, "00"), _
                            "Tabelle1", _
                            "H31", _
                            Worksheets("Tabelle1").Range("H28")) Then _
                            MsgBox "Bitte berichtigen"
    '"F:\dokumente und Einstellungen\AdminUser\Dektop\eee\", _             = Speicherpfad
    '"Wochenzettel_KW_" & Format(Format(Date, "ww",,) - 1, "00"), _          = Dateiname
    '"Tabelle1", _                                   vbfirstFourDays                      = Tabellenname
    'Worksheets("Tabelle1").Range("H31"), _                                = aus dieser Zelle wird der Wert genommen
    'Worksheets("Tabelle1").Range("H28"))                                  = in diese Zellle wird er geschrieben
    
    'Workbooks.Open FileName "F:\dokumente und Einstellungen\AdminUser\Dektop\eee\Wochenzettel_KW_" & FORMAT(Date,"ddmmyyyy") & ".xls"
End Sub

und füge noch diese Funktion

Code:

'Kalenderwoche nach DIN
Function KALENDERWOCHE_DIN(Datum As Date) As Integer
    'von Christoph Kremer, Aachen
    'Berechnt die KW nach DIN 1355
    Dim t&
    t = DateSerial(Year(Datum + (8 - Weekday(Datum)) Mod 7 - 3), 1, 1)
    KALENDERWOCHE_DIN = (Datum - t - 3 + (Weekday(t) + 1) Mod 7) \ 7 + 1
End Function

mit ein.

[Didi]

Es klappt, allerdings wird immer H31 von KW 03 ausgelesen und übertragen.

Didi

Edit:

Die KW ist abhängig vom aktuellen Datum des Rechners, ich werde mal alles testen.

Didi

[Steffl]

Hallo Didi,

Die KW ist abhängig vom aktuellen Datum des Rechners....

Genauso ist es. Von was willst Du die vorhergehende Kalenderwoche sonst rausfinden? Vom Formelergebnis in der Zelle E2? Dann müßtest Du aus der Kalenderwoche das Datum berechnen, von diesem 7 Tage abziehen und danach wieder in die Kalenderwoche umrechnen. Dies ist wegen des Jahreswechsel erforderlich. Aus diesem Grund habe ich auch das Makro nochmals geändert.

Code:

Sub test()
    Dim intKW As Integer
    
    intKW = KALENDERWOCHE_DIN(Date - 7) 'eine Woche zurückrechnen
    
    'MsgBox "Wochenzettel_KW_" & Format(intKW, "00")
    If Not GetDataClosedWB(ThisWorkbook.Path, _
                            "Wochenzettel_KW_" & Format(intKW, "00"), _
                            "Tabelle1", _
                            "H31", _
                            Worksheets("Tabelle1").Range("H28")) Then _
                            MsgBox "Bitte berichtigen"
    '"F:\dokumente und Einstellungen\AdminUser\Dektop\eee\", _             = Speicherpfad
    '"Wochenzettel_KW_" & Format(Format(Date, "ww",,) - 1, "00"), _          = Dateiname
    '"Tabelle1", _                                   vbfirstFourDays                      = Tabellenname
    'Worksheets("Tabelle1").Range("H31"), _                                = aus dieser Zelle wird der Wert genommen
    'Worksheets("Tabelle1").Range("H28"))                                  = in diese Zellle wird er geschrieben
    
    'Workbooks.Open FileName "F:\dokumente und Einstellungen\AdminUser\Dektop\eee\Wochenzettel_KW_" & FORMAT(Date,"ddmmyyyy") & ".xls"
End Sub

Für die Umrechnung von der KW in ein Datum kannst Du dich hier schlau machen.

[Didi]

:28:28:28:28:28:28:28:28:28:28:28:28:
Hallo Stefan, zunächst möchte ich mich bei ganz, ganz doll bedanken.:28:
:23:23:23:23:23:23:23:23:23:23:23:23: für diese Arbeit

Die Übernahme anhand des Rechnerdatums ist Ok.

Ich habe mich, da ich ja auch etwas machen möchte, schlau gemacht und die erste Meldung zu einer Abfragebox geändert.
(Hat bis zur funktionsfähigkeit nur 3 Std. gedauert:20:)
Wenn ich nun die Übernahme nicht wünsche kann ich das Makro beenden.

Nun noch das alles automatisch starten und ein eigenes Zertifikat erstellen damit Makros nicht pauschal zulässig sind.
Diese Schnippsel sollte ich im Netz finden und selber einpfegen können.

Didi