Funktionslose Datei - Refresh Code Arbeitsmappe
05.01.2016 08:31:01
Jens
ich habe ein Problem.
Ich erstelle mittels nachfolgendem Code eine Excel-Datei die ohne jegliche Funktion ist.
Sub FUK_schild()
Application.EnableEvents = False
On Error GoTo ErrorHandler
Dim shZiel As Worksheet
Dim shQuelle As Worksheet
Set shQuelle = ThisWorkbook.Sheets("Aufstellung") 'Quellsheet festlegen
Workbooks.Add 'neue Mappe
shQuelle.Copy Before:=ActiveWorkbook.Sheets(1) 'Kopieren des Quellsheets in die neue Mappe ( _
noch sind Formelbezüge drinn)
Set shZiel = ActiveWorkbook.Sheets("Aufstellung")
shZiel.Cells.Copy 'gesamten Bereich der Kopie kopieren
shZiel.Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False 'nur Werte wieder einfügen
'Spalten entfernen
shZiel.Columns("FA:FC").Delete
shZiel.Columns("BQ:ER").Delete
Application.DisplayAlerts = False
ActiveWorkbook.Sheets("Tabelle1").Delete 'Standardblatt aus neuer Mappe entfernen
Application.DisplayAlerts = True
Application.EnableEvents = True
With Application.FileDialog(msoFileDialogSaveAs)
Application.DisplayAlerts = False
.FilterIndex = 1
If .Show = -1 Then
ActiveWorkbook.SaveAs .SelectedItems(1)
Application.DisplayAlerts = True
End If
End With
Exit Sub
ErrorHandler:
Resume Next
End Sub Nun ist es so, dass ich in der DieseArbeitsmappe nachfolgenden Code habe.
Option Explicit
Public AktName As String
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not ActiveSheet.Name = AktName Then
MsgBox "Umbenennen des Blattes ist nicht erlaubt!"
ActiveSheet.Name = AktName
If ActiveWorkbook.Saved = False Then
ActiveWorkbook.Save
End If
End If
Application.Goto Tabelle1.Range("A1")
Worksheets("Aufstellung").Unprotect Password:="sperl"
Tabelle1.Range("X3").Clear
Worksheets("Aufstellung").Protect Password:="sperl"
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Range("A1").Select
AktName = Sh.Name
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
If Not Sh.Name = AktName Then
MsgBox "Umbenennen des Blattes ist nicht erlaubt!!!"
Sh.Name = AktName
End If
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
ActiveWorkbook.Save
End Sub
Private Sub Workbook_Open()
AktName = ActiveSheet.Name
Steuerelemente.Show
Tabelle1.BlattschutzErstellen
Application.Goto Tabelle1.Range("A1")
Dim Sh As Worksheet
For Each Sh In Worksheets
Sh.ScrollArea = "A1"
Next
'15 Minuten nach dem Öffnen wird das erste mal gespeichert
Application.OnTime Now + TimeValue("00:15:00"), "Speichern"
End Sub
Wenn ich nun den Code in meiner Userform ändern, funktioniert die Ausgabe über Sub FUK_schild() nicht mehr. Es hängt sich auf.
Wenn ich dann den Code aus der DieseArbeitsmappe kopiere, dann den Code wieder reinkopiere und die Datei speichere, funktioniert die Ausgabe der Exceldatei wieder.
Aber es kommt dann die Meldung aufgrund meines Skriptes.
"Umbenennen des Blattes ist nicht erlaubt!!!"
Dann kommt die Fehlermeldung Anwendungs und objektdefiniert Fehler.
Es wird die Zeile
ActiveSheet.Name = AktName
Gelb eingefärbt.
Wenn ich den Debugg beende, funktionierte die Ausgabe der funktionslosen Datei.
Wenn die Excel-Datei auf einem anderen PC geöffnet wird, passiert genau das selbe, dass sich die Datei aufhängt.
Erst wenn ich den Code rauskopiere, den Code wieder reinkopiere und die Datei speichere, bzw. die Meldungen wegklicke, dann geht die Ausgabe.
Hat hierzu wer eine Idee warum das so ist und wie man hier Abhilfe schaffen kann?
Gruß