Ich habe einen Updater. An und für sich funktioniert dieser. Jedoch muss ich jetzt noch eine zusätzliche Funktion einbauen, die mir immer einen Fehler anzeigt.
Aber zuerst mal hier der Code:
-------------------------------------------------
Private Sub CommandButton1_Click()
Dim wkbUpdate As Workbook
Dim wkbAlt As Workbook, wksData As Worksheet
Dim varAuswahl As Variant, arrSheet() As String, intI As Integer
On Error GoTo Beenden
'Dateiauswahldialog anzeigen
varAuswahl = Application.GetOpenFilename( _
Filefilter:="Excel(*.xls;*.xlsx;*.xlsm;*.xlsb),*.xls;*.xlsx;*.xlsm;*.xlsb", _
Title:="Bitte bestehende Datei auswählen")
If varAuswahl = False Then
MsgBox "Die Aktualisierung der bestehnden Datei wurde abgebrochen! " & vbLf _
& "Bitte Update nochmals starten!", _
vbInformation + vbOKOnly, "U P D A T E"
GoTo Beenden
End If
'Main-Datei-Objekte setzen
Set wkbUpdate = ActiveWorkbook
Application.ScreenUpdating = False
'alte Datei schreibgeschützt öffnen
Set wkbAlt = Application.Workbooks.Open(Filename:=varAuswahl, ReadOnly:=True)
Workbooks(varAuswahl).Sheet("Ansichtspinne").Visible = True
Workbooks(varAuswahl).Sheet("Gesamtansicht").Visible = False
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Sheets
If ws.Name = "GesamtansichtTotal" Then
ActiveWorkbook.Sheets("GesamtansichtTotal").Delete
End If
Next ws
With wkbAlt
'Sicherungskopie der alten Datei erstellen
.SaveCopyAs Filename:=.Path & "\" _
& "Update-Sicherheitskopie_" & Format(Now, "YYYY-MM-DD hhmmss") & .Name
i = Sheets.Count
For Z = 1 To i
Sheets(Z).Unprotect
Next Z
If .Sheets.Count >= 8 Then
'Namen der zu kopierende Blätter in Array sammeln
ReDim arrSheet(8 To .Sheets.Count)
For intI = 8 To .Sheets.Count
arrSheet(intI) = .Sheets(intI).Name
Next
.Sheets(arrSheet).Copy after:=wkbUpdate.Sheets(wkbUpdate.Sheets.Count)
Erase arrSheet
Else
MsgBox "Keine Datentabellen in Datei vorhanden"
End If
'Daten-Datei wieder schließen
.Close savechanges:=False
End With
Set wkbAlt = Nothing
wkbUpdate.Activate
Application.ScreenUpdating = True
With Application.FileDialog(msoFileDialogSaveAs)
.Title = "Bitte Update-Datei unter neuem Namen speichern"
.InitialFileName = "AktualisierteDatei"
.FilterIndex = 2 '1= xlsx (Standard), 2 = xlsm
If .Show = -1 Then
wkbUpdate.SaveAs Filename:=.SelectedItems(1), addtomru:=True
MsgBox "Datei wurde erfolgreich aktualisiert", _
vbInformation + vbOKOnly, "U P D A T E"
ActiveWorkbook.Sheets("Ansichtspinne").Activate
Sheets("Ansichtspinne").Unprotect
Sheets("Ansichtspinne").Range("A1").Select
Sheets("Ansichtspinne").Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
True
Me.Hide
For ii = 8 To Sheets.Count
Sheets(ii).Cells.Replace What:=" ", Replacement:="", LookAt:=xlWhole
Next ii
Else
MsgBox "Speichern der aktualisierten Datei wurde abgebrochen!"
End If
End With
Beenden:
With Err
Select Case .Number
Case 0 'alles OK
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
If Not wkbAlt Is Nothing Then wkbAlt.Close savechanges:=False
End Select
End With
Application.ScreenUpdating = True
End Sub
--------------------------------------------------------
Das kursiv markierte habe ich jetzt noch selbst eingefügt. Es sollte folgendes bewerkstelligen: In der zuvor per Auswahlfenster geöffneten Datei sollte das Blatt "Ansichtspinne" sichtbar und dafür das Blatt "Gesamtansicht" unsichtbar werden. Als letzte Vorbereitung sollte in dieser Datei geprüft werden, ob ein Tabellenblatt mit dem Namen "GesamtansichtTotal" vorhanden ist, und wenn ja sollte es gelöscht werden.
Momentan wird mir aber immer ein Fehler Nr. 9 angezeigt...
Vielen Dank schon mal im Voraus für alle Hilfe...