Automatische Berechnung wirklich ausschalten?
07.01.2016 07:39:27
herman_the_german
am Anfang eines jeden Monats, soll eine Datei archiviert werden, da in dieser Datei "live" Berechnung stattfinden, soll die Datei beispielsweise am 01.01.16 natürlich nicht mit den neu berechneten Werte exportiert werden, sondern den Stand von 31.12.2016 aufweisen. Demzufolge habe ich beim Öffnen und zur Sicherheit noch einmal im Modul, die automatische Berechnung deaktiviert. Um das Ganze nun zu überprüfen, habe ich eine eine Zelle mit dem Format Uhrzeit die Formel =JETZT() geschrieben, um zu prüfen, ob er auch wirklich erst exportiert und dann berechnet. Was soll ich sagen, es funktioniert nicht. In der exportierten Datei steht immer genau die Zeit, vom Öffnen der Datei drin - was ja an sich nicht sein dürfte.
Kurze Codeaufbau:
Workbook_Open:
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Sheets("Blatt1").Range("A33").Value Month(Now) Then
Call read
Else
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End If
End Sub
Modul
ub read()
Dim Datei As String
Dim pfad As String
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Datei = "Report"
pfad = "Netzwerkpfad" & "\"
ThisWorkbook.Sheets(Array("Blatt1", "Diagramm1", "Diagramm2", "Diagramm_3", "Diagramm4")).Copy
ActiveSheet.Range("A1:AG39").Cells = ActiveSheet.Range("A1:AG39").Cells.Value
ActiveWorkbook.SaveAs Filename:=pfad & Datei & Format(Now, "_YYYY_MM") & ".xlsx", _
FileFormat:=51, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
If Sheets("Blatt1").Range("AG8").Value = Sheets("Blatt1").Range("B8").Value Then
Range("AG10:AG12").Select
Selection.Copy
Range("B10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AG14:AG16").Select
Selection.Copy
Range("B14").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AG22:AG24").Select
Selection.Copy
Range("B22").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
If Sheets("Blatt1").Range("AF8").Value = Sheets("Blatt1").Range("B8").Value Then
Range("AF10:AF12").Select
Selection.Copy
Range("B10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AF14:AF16").Select
Selection.Copy
Range("B14").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AF22:AF24").Select
Selection.Copy
Range("B22").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
If Sheets("Blatt1").Range("AE8").Value = Sheets("Blatt1").Range("B8").Value Then
Range("AE10:AE12").Select
Selection.Copy
Range("B10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AE14:AE16").Select
Selection.Copy
Range("B14").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AE22:AE24").Select
Selection.Copy
Range("B22").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
If Sheets("Blatt1").Range("AD8").Value = Sheets("Blatt1").Range("B8").Value Then
Range("AD10:AD12").Select
Selection.Copy
Range("B10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AD14:AD16").Select
Selection.Copy
Range("B14").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AD22:AD24").Select
Selection.Copy
Range("B22").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Wahrscheinlich geht die ganze Kopierprozedur auch weitaus schöner, es funktioniert aber. Die meines erachtens wichtigen Stellen zur Deaktivierung und Aktivierung der Berechnung habe ich entsprechend markiert.
Wie kann man also nun die automatische Berechnung wirklich deaktivieren und erst nach dem Export bzw. wenn die IF-Bedingung im Workbook_Open False zurückgibt aktivieren? Hat es vielleicht etwas damit zu tun, wie die Datei archiviert bzw. alles kopiert wird?
Danke im Voraus!
Anzeige