"Unlogischer" Ablauf...
Bowl
mir ist beim besten willen kein besserer Betreff eingefallen:
Folgendes
U.a. beim schliessen soll eine "Archivieren" und eine "SIchern" schleife Durchlaufen.
Also 1.
in der Beforeclose:
Call archivieren
Call sichern
ob automatisches archivieren/sichern aktiviert ist. (abfrage von 2 checkboxen)
wenn ja werden die beiden auch entsprechen aufgerufen und laufen fehlerfrei durch.
hier mal die 2:
Sub Auto_Archivieren()
Dim sh As Worksheet
Dim a, b, C, y As Integer
Application.ScreenUpdating = False
Workbooks.Open Filename:="N:\xxx\Auftragsplanung 2009\archiv.xls"
Windows("Auftragsplanung.xls").Activate
For Each sh In ThisWorkbook.Worksheets
a = sh.Cells(2, 20).Value
b = sh.Cells(2, 17).Value
Windows("Archiv.xls").Activate
y = ActiveWorkbook.Sheets.Count
If IsNumeric(sh.Name) Then
If sh.Cells(2, 20).Text "#NV" Then
If (a + 1) Sub Sicherungskopie()
Dim sh, ws, she As Worksheet
Dim x As Integer
Dim i As Integer
Dim ding As Object
Application.DisplayAlerts = False
Application.ScreenUpdating = False
x = ActiveSheet.Cells(2, 17).Value
NameKopie = "N:\xxx\Auftragsplanung 2009\Sicherung\Sicherung-KW" & x & ".xls"
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=NameKopie
y = ActiveWorkbook.Name
For Each sh In ThisWorkbook.Worksheets
Windows("Auftragsplanung.xls").Activate
i = Workbooks(y).Sheets.Count
If IsNumeric(sh.Name) Then
Windows("Auftragsplanung.xls").Activate
Sheets(sh.Name).Copy After:=Workbooks(y).Sheets(i)
End If
Next
Windows("Auftragsplanung.xls").Activate
i = Workbooks(y).Sheets.Count
Sheets(Array("Kapazitätsveränderungen", "Gesamt", "Einschätzung Dauer", _
"Jahresübersicht")).Select
Sheets(Array("Kapazitätsveränderungen", "Gesamt", "Einschätzung Dauer", _
"Jahresübersicht")).Copy After:=Workbooks(y).Sheets(i)
Workbooks(y).Activate
For Each ws In Workbooks(y).Worksheets
ws.Unprotect
For Each myShape In ws.Shapes
myShape.Delete
Next
ws.UsedRange.Copy
ws.UsedRange.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Cells(1, 1).Select
ws.Cells(1, 11).Value = "Akt. KW"
ws.Cells(1, 12).FormulaLocal = "=Kalenderwoche(Heute())"
ws.UsedRange.Locked = True
ws.Protect
Application.CutCopyMode = False
Next ws
With ActiveWorkbook.VBProject
For Each objVBC In .VBComponents
Select Case objVBC.Type
Case 1, 2, 3
.VBComponents.Remove .VBComponents(objVBC.Name)
Case 100
With objVBC.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next
End With
ActiveWorkbook.Save
Windows("Auftragsplanung.xls").Activate
Workbooks(y).Close
Sheets("Vorlage").Select
Application.ScreenUpdating = True
x = ActiveSheet.Cells(2, 17).Value
fragt die aktuelle KW ab, die dann in den Namen der sicherung geschrieben wird
Mein Problem ist jetz:
Falls Sichern vor Archivieren durchläuft, ich also die Calls umdrehe oder aber automatisch_archivieren deaktiviert ist, kommt es zu einem Fehler:
statt dem wirklichen Wert in der entsprechenden Zelle wird stattdessen der Wert 0 eingesetzt, und ich weiß beim besten willen nicht warum.
Irgendjemand eine IDee woran das ganze liegen könnte?
Viele Dank im vorraus
Bowl
P.S. Code ist noch nicht der eleganteste, hab ihn bislang aber noch nicht verkürzt, wollt erstmal schauen dass alles so läuft ...