Code funzt nicht bei Office 2016/win10
02.03.2019 18:28:17
Henno
Unter meiner "Heim-Umgebung" (Office 2013/ win10) funktioniert folgender Code problemlos:
Sub Progressbar3()
Set wb = ActiveWorkbook
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:="***"
ActiveSheet.Copy
VBALöschen
Dim oWSHShell As Object
Set oWSHShell = CreateObject("WScript.Shell")
GetDesktop = oWSHShell.SpecialFolders("Desktop")
ActiveWorkbook.SaveAs "" & GetDesktop & "\Kopie vom " & Format(Date,"YYYY_MM_DD") & ".xlsx" _
, FileFormat:=xlOpenXMLWorkbook, WriteResPassword:="tigger"
ActiveSheet.Shapes.SelectAll
Selection.Delete
ActiveSheet.Rows("77:167").Clear
ActiveSheet.Columns("C:G").ClearContents
ActiveSheet.Columns("C:G").Delete
ActiveSheet.Columns("G:CU").ClearContents
ActiveSheet.Columns("G:CU").Delete
ActiveSheet.Columns("AL:AW").ClearContents
ActiveSheet.Columns("AM:AW").Delete
ActiveSheet.Columns("BP:CA").ClearContents
ActiveSheet.Columns("BQ:CA").Delete
ActiveSheet.Columns("CV:DG").ClearContents
ActiveSheet.Columns("CW:DG").Delete
ActiveSheet.Columns("EA:EL").ClearContents
ActiveSheet.Columns("EB:EL").Delete
ActiveSheet.Columns("FG:FR").ClearContents
ActiveSheet.Columns("FH:FR").Delete
ActiveSheet.Columns("GL:GW").ClearContents
ActiveSheet.Columns("GM:GW").Delete
ActiveSheet.Columns("HR:IC").ClearContents
ActiveSheet.Columns("HS:IC").Delete
ActiveSheet.Columns("IX:JI").ClearContents
ActiveSheet.Columns("IY:JI").Delete
ActiveSheet.Columns("KC:KN").ClearContents
ActiveSheet.Columns("KD:KN").Delete
ActiveSheet.Columns("LI:LT").ClearContents
ActiveSheet.Columns("LJ:LT").Delete
ActiveSheet.Columns("MN:MY").ClearContents
ActiveSheet.Columns("MO:MY").Delete
ActiveSheet.Columns("NT:OE").ClearContents
ActiveSheet.Columns("NU:OE").Delete
ActiveSheet.Columns("OZ:PM").ClearContents
ActiveSheet.Columns("OZ:PM").Delete
Formel = "=DATUM(JAHR($DA$1);MONAT($DA$1);TAG(1))"
ActiveSheet.Range("G3").FormulaLocal = Formel
ActiveSheet.Cells.Select
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
ActiveSheet.Cells.Select
Selection.SpecialCells(xlCellTypeComments).ClearComments
Application.Goto Reference:=ActiveSheet.Cells(1, 1), Scroll:=True
ActiveWorkbook.Save
ActiveWorkbook.Protect Password:="***", Structure:=True, Windows:=False
ActiveWorkbook.Close
wb.Activate
Tabelle1.Activate
ThisWorkbook.Sheets("Jahresübersicht").Range("D1").Value = Date
ActiveSheet.Protect Password:="***", Userinterfaceonly:=True, DrawingObjects:=False, _
Contents:=True, Scenarios:=True, AllowFormattingCells:=True
Dim lSpalte As Variant
With ThisWorkbook.Worksheets("Jahresübersicht")
lSpalte = WorksheetFunction.Match(CDbl(Date), .Rows(3), 0)
If IsNumeric(lSpalte) Then
Application.Goto Reference:=ActiveSheet.Cells(3, (lSpalte - Day(Date) + 1)), Scroll:= _
True
End If
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Unload PB3
MsgBox "-Kopie- wurde auf dem Desktop gespeichert!"
End Sub
Ich erstelle damit aus einer großen Übersicht eine Kopie, lösche alle Buttons, lösche verschiedene Teile des Sheets, die bei der Kopie unwichtig sind bzw. in der Kopie-Ansicht nicht gezeigt werden sollen.Anschließend will ich alle Kommentare in der neuen Datei löschen.
Bei dem Befehl "activesheet.cells.select" wird bei Office 2016 plötzlich als Fehler angezeigt, "Die Methode Select ist bei dem Objekt Range fehlgeschlagen".
Es lässt sich auch nicht debuggen, sondern Excel schliesst sich komplett und muss neu gestartet werden.
Diesen Fehler bei Google eingegeben mit Fehlernummer (-21.............(8.........)) brachte mir nicht die Erleuchtung.
Vielleicht ist hier ein Crack, der das Problem lösen kann.
Danke im Voraus,
Gruß Henno
PS: Meine VBA-Kenntnisse beschränken sich auf Makrorekorder sowie Code-Schnipsel aus dem Internet, also nix fundiertes...daher vielleicht der ein oder andere Befehl, wo andere die Hände über den Kopf zusammenschlagen.....Aber Hey...it works....jedenfalls fast ;)