AW: Formelberechnung erst nach Workb. close / Wb. open
24.02.2009 13:22:03
Alex
Hi Renèe,
kenn mich auch nich mehr aus, habe alles versucht (oben genannte Codezeilen) was nur irgendwie helfen könnte.
Hier hab ich mal einen Gesamtcode abgebildet in dem die Codezeilen dabei sind.
Erklärung:
dieser Code bewirkt, dass ich ein vorher bestehendes Tab. (durch Eintrag in Zelle A4 des Tab.) umbenenne,
der neue Tab-Name in einer Auflistung erscheint, die dann alph. Sortiert wird;
dann werden die Tab. alph. Sortiert und gut.
Hab die versch. Codes meiner beiden Dateien schon verglichen. Die eine berechnet Formeln sofort, die schlechte erst...wie vorher beschrieben.
Hier der Code:
Sub AuflistungUndSheetsSortieren()
'Blattname aus Zelle des Blattes
Dim Blatt As Object 'Blattname aus Zelle des Blattes
Dim i As Long, j As Long 'Auflistung aller Tabellen so wie ihre momentane Reihenfolge _
ist
Dim x As String 'Auflistung aller Tabellen so wie ihre momentane Reihenfolge _
ist
Dim all As Long 'Auflistung aller Tabellen so wie ihre momentane Reihenfolge _
ist
Dim shArray() 'Auflistung aller Tabellen so wie ihre momentane Reihenfolge _
ist
Dim WsW As Worksheet ' Register sortieren ' Variable für Tabelle
Dim InI As Integer ' Register sortieren ' Schleifenvariable
Dim InJ As Integer ' Register sortieren ' Schleifenvariable
'sheets sichtbar machen
Application.ScreenUpdating = False
For InI = Sheets.Count To 1 Step -1
Sheets(InI).Visible = True
Next InI
Application.ScreenUpdating = True
'Blattname aus Zelle des Blattes
On Error Resume Next
For Each Blatt In ActiveWorkbook.Worksheets
'"Übersicht" ; "Grundformular" ; "ListeHäufigerEintragungen" ; "Übersicht Schießen"
If Blatt.Name "Übersicht" And _
Blatt.Name "Grundformular" And _
Blatt.Name "ListeHäufigerEintragungen" And _
Blatt.Name "Übersicht Schießen" Then
With Blatt
If .Cells(4, 1) "" Then
.Name = .Cells(4, 1) 'zelle A4 (1.Spalte,4.Zeile)
Else
.Name = "zzz" & .CodeName
End If
End With
End If
Next Blatt
Sheets("Übersicht Schießen").Unprotect "red13"
Sheets("Übersicht Schießen").Select
Selection.AutoFilter Field:=1
'Auflistung (in Spalte C) aller Tabellen so wie ihre momentane Reihenfolge im Workbook ist
all = ThisWorkbook.Worksheets.Count
ReDim shArray(5 To all)
On Error Resume Next
For i = 5 To all '5 to all = ab dem Blatt das momentan auf Platz 5 liegt
x = ThisWorkbook.Sheets(i).Name
shArray(i) = x
Next i
For j = LBound(shArray) To UBound(shArray)
Sheets(4).Cells(j + 1, 3) = shArray(j) 'C...ab wohin die Namen in Übersicht Schießen _
geschrieben werden j + 1 = 2.Zeile, 3 = 3.Spalte
Next j
'alphab. Sortierung Übersicht Schießen ab C6 - S153
Sheets("Übersicht Schießen").Select
Range("C6:S153").Select
Selection.Sort Key1:=Range("C6"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("J1").Select
Sheets("Übersicht Schießen").Protect "red13", DrawingObjects:=True, Contents:=True, Scenarios:= _
True
' Register sortieren
Application.ScreenUpdating = False ' Bildschirmaktualisierung aus
Set WsW = ActiveSheet ' aktuelle Tabelle auf Variable _
schreiben
For InI = 5 To ActiveWorkbook.Worksheets.Count
For InJ = InI To ActiveWorkbook.Worksheets.Count
If Worksheets(InJ).Name LCase("Übersicht") Then
Sheets(InI).Visible = False
End If
Next InI
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Sheets("Übersicht").Select
Sheets("Übersicht").Protect "red13", DrawingObjects:=True, Contents:=True, Scenarios:=True
Range("A5").Select
End Sub
Danke für dein Interesse,
alex