Exceltabelle am Monatsende automatisch speichern, schließen und leere Vorlage öffnen

[Jochen Kühner]

Zuviel Werbung?
-> Hier kostenlos registrieren

Und das nächste Problem:

Habs um zu testen mal mit meiner PC Uhr simuliert, dabei ist mir folgendes Problem aufgefallen:

Beim Start wird die ganze Prozedur gestartet:

wenn das "aktDate <> endDate" ist, passiert nichts (ist ja auch gut so).

wenn sich dann das Datum so ändert, dass "aktDate = endDate" ist passiert auch nichts

Wenn allerdings das "aktDate = endDate" ist und erst dann die Datei geöffnet wird, dann funktioniert es.

Hab meins zur Vorsicht nochmals angehängt:

Sub Workbook_Open()
    Dim aktDate As Date   'aktuelles Datum
    Dim endDate As Date   'Monatsende
    Const pfad As String = "C:\Users\Administrator\Desktop\Verfügbarkeit_"
      
    aktDate = Format(Now(), "dd.mm.yyyy")
    
    endDate = DateSerial(Year(aktDate), Month(aktDate) + 1, 1) - 1
        
    If Dir(pfad & endDate & "*") = "" Then
        If (aktDate = endDate) Then
            ActiveWorkbook.SaveAs Filename:=pfad & endDate & ".xlsm"
            Workbooks.Open pfad & "Vorlage.xlsm"
            ThisWorkbook.Close False
        End If
    End If
    
End Sub

Muss man da mit einer Schleife arbeiten?
Denn jetzt wird das gestartet beim Öffnen...wenn die Bedingung nicht erfüllt ist, also "endDate <> aktDate" ist, dann ist das ja für das Programm erledigt und es kommt ja gar nicht mehr an den Anfang des if-Blocks?

Ja, du musst das script immer wieder aufrufen, documentopen sagt ja schon, das wird nur beim öffnen gemacht. Das zyklische aufrufen kannst du bspw mit Application.OnTime now + timevalue("24:00:00"), "test"
Machen

 

[PHW]

Alles klar, Danke!

und wo genau muss ich das einbinden? bekomm je nachdem wo ich es einfüge unterschiedliche fehlermeldungen!

 

[PHW]

Zuviel Werbung?
-> Hier kostenlos registrieren

Funktioniert leider nicht :-(

Sub Auto_Open()

    Dim aktDate As Date   'aktuelles Datum
    Dim endDate As Date   'Monatsende
    Const pfad As String = "C:\Users\Administrator\Desktop\Verfügbarkeit_"
      
    aktDate = Format(Now(), "dd.mm.yyyy")
    
    endDate = DateSerial(Year(aktDate), Month(aktDate) + 1, 1) - 1
   
    If Dir(pfad & endDate & "*") = "" Then
        If (aktDate = endDate) Then
            ActiveWorkbook.SaveAs Filename:=pfad & endDate & ".xlsm"
            Workbooks.Open pfad & "Vorlage.xlsm"
            ThisWorkbook.Close False
        End If
    End If
    
    Application.OnTime Now + TimeValue("00:00:10"), "Auto_Open"
    
    
End Sub

Dieser Code wurde im Modul1 eingefügt. Wenn er unter "Diese Arbeitsmappe" gespeichert wird kann er nicht auf das Makro zugreifen. Wie ich bis jetzt raus gefunden habe, muss es eben in einem Modul stehen!

Wenn ich dann die Exceldatei öffne funktioniert es, dann änder ich das Datum auf den Monatsletzten, dann wird die Datei gespeichert und die Vorlage geöffnet...Funktioniert alles gut bis dahin:

Dann hab ich festgestellt das "Autpen" nicht ausgeführt wird, wenn ich die Datei mit

Workbooks.Open pfad & "Vorlage.xlsm"

öffne!
Muss nachdem es das erste mal funktioniert hat immer wieder manuell gestartet werden. Ich verstehs nicht

 

[Jochen Kühner]

Dann speicher die aktuelle mappe mit saveas lass sie offen und lösche den inhalt!

 

[pm]

Wenn die Datei geöffnet bleibt, dann ist die Methode "Autpen" natürlich nicht die Lösung. Wie sieht denn das "OPC"-Makro aus, da kannst Du vielleicht die Abfrage einbauen bzw. den Aufruf mit "Call Makroname" machen.

 

[PHW]

Zuviel Werbung?
-> Hier kostenlos registrieren

Guten Morgen,

ich hab jetzt alles so gelöst, und es funktioniert auch...fast

Das in "Diese Arbeitsmappe"

Private Sub Workbook_Open()
     'When the Workbook is opened the timer is activated to run MyMacro at one second past midnight
     Application.OnTime TimeValue("00:00:01"), "MonatlichSpeichern"
End Sub

Das in "Modul1"

Sub MonatlichSpeichern()

    'the timer is reactivated to run MyMacro again tomorrow at one second past midnight
    Application.OnTime TimeValue("00:00:01"), "MonatlichSpeichern"

    Dim aktDate As Date   'aktuelles Datum
    Dim endDate As Date   'Monatsende
    Const pfad As String = "C:\Users\Administrator\Desktop\Verfügbarkeit_"
      
    aktDate = Format(Now(), "dd.mm.yyyy")
    
    endDate = DateSerial(Year(aktDate), Month(aktDate) + 1, 1) - 1
   
        If (aktDate = endDate) Then
        'save the current file to another location
        ActiveWorkbook.SaveAs ("C:\Users\Administrator\Desktop\Verfügbarkeit_" & endDate & ".xlsm")
        
        'Delete all data from the range A1:D10
        Range("B2:D10").ClearContents
        
        End If
    
End Sub

Die Funktion ist so wie ich zufrieden bin: Am Monatsende wird die Datei unter dem Monatsletzten gespeichert ("Verfügbarkeit_Datum.xlsm").
aber das löschen der Zellen funktioniert noch nicht!

Ich habe 15 Tabellenblätter in der Exceldatei und in allen möchte ich nachdem die Datei gespeichert wurde die Spalte B,C,D von B3/C3/D3 bis nach Unten löschen. Kann mir da vielleicht noch jemand helfen?

@pm

Das OPC Makro ist ein Client der mir dauernd den Zustand einer Variablen abfragt und mir den aktuellen Status mit Zeitstempel der Zustandänderung in eine Zeile schreibt! So kann ich mir die Anlagenverfügbarkeit aufzeichnen und graphisch darstellen!
Z.B. Maschine xy lief letzten Monat 30% auf Vollast, 50% auf Teillast und 20% Störungen. War das eigentliche Thema meiner Technikerarbeit und funktioniert einwandfrei...Als kleines Zusatzding hab ich mir dieses Thema hier noch einfallen lassen. War nicht gefordert, aber man lernt ja immer für sich selbst

Das Makro ist in jedem Tabellenblatt gespeichert und wird beim öffnen automatisch gestartet! Hab dazu ein Autpen in Modul1 eingefügt, das mir jedes Makro im jeweiligen Tabellenblatt startet!

Aber wie gesagt, das einbinden werd ich hinbekommen...nur eben noch die Funktion mit den Zellen löschen...

Danke nochmals

Grüße Phil

 

[pm]

in jedem Blatt Bereich B3:C3 bis nach unten löschen...

    For Each sh In ThisWorkbook.Sheets
        sh.Select
        Range("B3:D3").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.ClearContents
    Next

 

[PHW]

Danke, funktioniert bis auf Tabellenblatt1, Da werden nur die erste 5 Zeilen gelöscht?

 If (aktDate = endDate) Then
        'save the current file to another location
        ActiveWorkbook.SaveAs ("C:\Users\Administrator\Desktop\Verfügbarkeit_" & endDate & ".xlsm")
        
        'Delete all data from the range B3:D3
        For Each sh In ThisWorkbook.Sheets
        sh.Select
        Range("B3:D3").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.ClearContents
        Next
        
        'Resave

        ActiveWorkbook.SaveAs ("C:\Users\Administrator\Desktop\Verfügbarkeit_Vorlage" & ".xlsm")

        End If

Ich speicher mir die Datei wieder unter Vorlage, da sonst die monatlich gespeicherte Datei zur weiteren Aufzeichnung verwendet wird. Kann ich das so Programmieren das die Meldung "Datei gibt es schon, soll ersetzt werden? nicht kommt, bzw. mit "Ja" beantwortet wird?

 

[PHW]

Zuviel Werbung?
-> Hier kostenlos registrieren

Habs rausgefunden:

Application.DisplayAlerts = False
'Dann speichern

[FONT=Arial][SIZE=2][COLOR=#000000]Application.DisplayAlerts = True[/COLOR][/SIZE][/FONT]

Allerdings versteh ich noch nicht warum er mir im ersten tabellenblatt nur die ersten paar Zeilen löscht...

 

[pm]

probiers mal damit... Vielleicht mag er das "Selection.End(xlDown)" nicht

    For Each sh In ThisWorkbook.Sheets
        sh.Range("B2:D65536").ClearContents
    Next

 

[Paule]

probiers mal damit... Vielleicht mag er das "Selection.End(xlDown)" nicht

[COLOR=black][FONT=Verdana]  For Each sh In ThisWorkbook.Sheets[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      sh.Range("B2:D65536").ClearContents[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]  Next[/FONT][/COLOR]

Bei der Variante werden halt auch unnötige Zeilen markiert und gelöscht.

Ich habe das bisher immer so gelöst:

[COLOR=black][FONT=Verdana]Dim ZeileEnd[/FONT][/COLOR]
[FONT=Verdana][COLOR=black]  Selection.SpecialCells(xlLastCell).Activate[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]          ZeileEnd = Selection.Row[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]  Range(Cells(3, 2), Cells(ZeileEnd, 4)).Select[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]  Selection.ClearContents[/COLOR][/FONT]

@PM: Allerdings gefällt mir Deine erste Variante viel besser und bei einem kurzen Test hat sie auch funktioniert, darum ein dickes

 

[PHW]

Zuviel Werbung?
-> Hier kostenlos registrieren

Die erste Lösung wär sicher die sauberste und eleganteste Lösung gewesen, funktioniert eigentlich auch.
Aber immer im ersten Tabellenblatt funktioniert sie eben nicht?
Weiß auch nicht warum aber es werden immer unterschiedlich zwischen 5 und 12 zeilen gelöscht!

Naja, mit der anderen lösung gehts ja jetzt

habs nochmal mit "Selection.End(xldown)" versucht, klappt als "einfaches Makro" in einer anderen Tabelle hervorragend, aber bei mir mit eingebunden eben nicht perfekt!

 

[Paule]

habs nochmal mit "Selection.End(xldown)" versucht, klappt als "einfaches Makro" in einer anderen Tabelle hervorragend, aber bei mir mit eingebunden eben nicht perfekt!

Hast es schon mal mit dem
(xlLastCell) probiert?

 

[PHW]

Ne, hab ich noch nicht!
Aber ich werd es bei Gelegenheit testen.

Habs heute mal im Geschäft umgesetzt und funktioniert bis jetzt super!
Das es in der anderen Lösung immer die komplette Spalte löscht stört mich eigentlich recht wenig...muss ja nicht ich sondern das Programm arbeiten

Jetzt muss ich nur noch rausfinden wie ich die Datei so abspeicher, das diese beim Öffnen die Makros nicht mehr ausführen will, bzw die Makros nicht mehr drin sind...aber mal schaun was Dr.Google so weiß!

 

[Oberchefe]

Zuviel Werbung?
-> Hier kostenlos registrieren

Jetzt muss ich nur noch rausfinden wie ich die Datei so abspeicher, das diese beim Öffnen die Makros nicht mehr ausführen will, bzw die Makros nicht mehr drin sind...aber mal schaun was Dr.Google so weiß!

Shifttaste drücken beim Öffnen ist warscheinlich keine Lösung?

ohne dass ich den kompletten Thraed durchgelesen hätte: eine andere Möglichkeit wäre evtl. dass das Ding mit dem Makro beim Speichern eine Seite markiert, in ein neues Sheet kopiert und dieses dann jeweils abspeichert.

 

[Larry Laffer]

In dem Fall fällt mir da auch nur die Lösung von Oberchefe ein ... "Inhalte kopieren"

Gruß
Larry

 

[PN/DP]

Werte auslagern in csv-Datei

Wäre es nicht einfacher, statt am Monatsende die gesamte Excel-Datei umständlich speichern/wieder öffnen ...
nur die aufgezeichneten Werte per Script in eine csv-Datei zu schreiben?

Harald

 

[PHW]

Zuviel Werbung?
-> Hier kostenlos registrieren

Hi,

ich habs doch abgeändert. Ich speicher die Datei, lösch dir Daten raus und speicher die leere Datei nur nochmals zur Sicherheit.
Also quasi Speichern, leeren, speichern....

Das Ganze muss als Exceldatei gespeichert werden, da sich in der Datei Diagramme etc. befinden. Wenn sich derjenige, der sich für die Daten interessiert das in ner csv-Datei hat, muss er sich die Daten ja erstmal wieder importieren!

@ Oberchefe

1. Nein, Shifttaste drücken beim Öffnen ist keine Lösung

2. eine andere Möglichkeit wäre evtl. dass das Ding mit dem Makro beim Speichern eine Seite markiert, in ein neues Sheet kopiert und dieses dann jeweils abspeichert.

Eigentlich würde es reichen wenn ich ein Diagramm mit den dazugehörigen Zellen G1:J2 speichern würde (*15 Tabellenblätter)...

Aber wie stell ich das an?
Wenn ich das auswähle und dann speicher, werden dann nicht die makros auch abgespeichert?

 

[Larry Laffer]

Eigentlich würde es reichen wenn ich ein Diagramm mit den dazugehörigen Zellen G1:J2 speichern würde (*15 Tabellenblätter)...

Aber wie stell ich das an?
Wenn ich das auswähle und dann speicher, werden dann nicht die makros auch abgespeichert?

Nein, dann kann du erreichen, dass du nur die Inhalte kopierst (ohne die Logik).
Das kannst du am Besten ausprobieren, wenn du das Ganze handisch machst und währenddessen ein Makro aufzeichnest und das dann editierst ...

Gruß
Larry

 

[pm]

Kopiere einfach die Blätter die du brauchst und dann speichern...

z.B

Sheets(Array("Tabelle1", "Tabelle2", "Tabelle3")).Copy
ActiveWorkbook.SaveAs ("C:\Users\Administrator\Desktop\Verfügbarkeit_Vorlage" & ".xlsm")