Code ändert Berechnungsopitonen auf Manuell
Fritz_W
den nachstehenden Code habe ich von Josef Ehrensberger.
Nun habe ich folgendes festgestellt:
Wird der Code unter Excel 2007 eingesetzt, hat er offenbar (im Gegensatz zum Einsatz unter Excel 2003) die unerwünschte Nebenwirkung, dass in den kopierten Arbeitsmappen unter
EXCEL-Optionen Formeln Berechnungoptionen
die Einstellung auf "Manuell" geändert wird.
Wie lässt sich das vermeiden?
Im Voraus vielen Dank für Eure Hilfe.
mfg
Fritz
Option Explicit
Sub copyMe()
Dim objWB As Workbook
Dim vbComp As Object
Dim rng As Range
Dim strSave As String, strExt As String, strSaveXLSM As String, intCnt As Integer
On Error GoTo ErrExit
GMS
For Each rng In ThisWorkbook.Sheets("Tabelle1").Range("A1:A20")
If rng "" Then
intCnt = intCnt + 1
Application.StatusBar = "Speichern von Datei " & CStr(intCnt) & " / " & rng.Text & Mid(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, "."))
strSave = ThisWorkbook.Path & "\" & rng.Text & Mid(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, "."))
ThisWorkbook.SaveCopyAs strSave
Set objWB = Workbooks.Open(strSave)
With objWB
With .Sheets("Tabelle1")
.Range("A1:A20").ClearContents
.Range("A1") = rng
.Rows(1).Hidden = True
End With
For Each vbComp In .VBProject.vbcomponents
If vbComp.Type = 100 Then
With .VBProject.vbcomponents(vbComp.Name).CodeModule
.DeleteLines 1, .CountOfLines
End With
Else
.VBProject.vbcomponents.Remove vbComp
End If
Next
strExt = Mid(strSave, InStrRev(strSave, "."))
If Len(strExt) > 4 Then strExt = Left(strExt, 4) & "x"
strSaveXLSM = Left(strSave, InStrRev(strSave, ".") - 1)
strSaveXLSM = strSaveXLSM & strExt
objWB.SaveAs strSaveXLSM, FileFormat:=IIf(Len(strExt) = 5, 51, -4143)
objWB.Close
Kill strSave
End With
End If
Next
ErrExit:
With Err
If .Number 0 Then MsgBox "Fehler " & .Number & vbLf & vbLf & _
.Description & vbLf & vbLf & "In Prozedur (copyMe) in Modul Modul1", _
vbExclamation, "Fehler in Modul1 / copyMe"
End With
GMS True
End Sub
Public Sub GMS(Optional ByVal Modus As Boolean = False)
Static lngCalc As Long
With Application
.ScreenUpdating = Modus
.EnableEvents = Modus
.DisplayAlerts = Modus
.EnableCancelKey = IIf(Modus, 1, 0)
If Not Modus Then lngCalc = .Calculation
If Modus And lngCalc = 0 Then lngCalc = -4105
.Calculation = IIf(Modus, lngCalc, -4135)
.Cursor = IIf(Modus, -4143, 2)
.StatusBar = False
End With
End Sub