4.1k Aufrufe
Gefragt in Tabellenkalkulation von raisix Mitglied (287 Punkte)

Hallo zusammen,

die Tabelle besteht aus 55 Blättern (53 für Kalenderwochen). Die Arbeitsmappe ist geschützt.

Der erste Teil des Codes färbt das Tabellenblatt rot, welches der aktuellen Kalenderwoche entspricht.

Der weitere Teil des Code ist dafür da, einen Hinweistext beim Öffnen anzuzeigen und die Arbeitsblätter zu sperren und dabei die Auto-Gliederung zuzulassen.

Mein Code ist leider noch fehlerhaft. Es wird folgender Fehler ausgegeben:

Laufzeitfehler '1004':

Anwendungs- oder objektdefinierter Fehler

Hier der VBA-Code:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Worksheets("" & DatePart("ww", Date, vbMonday, vbFirstFourDays)).Tab.ColorIndex = xlNone
End Sub

____________________________________________________________________________

Sub Workbook_Open()
 MsgBox "MUSTERTEXT.", 0, "Hinweis"
 Dim i As Long
 For i = 1 To Worksheets.Count
 Sheets(i).Protect userinterfaceonly:=True, Password:="Passwort"
 Sheets(i).EnableOutlining = True 'für Gliederung
 Sheets(i).EnableAutoFilter = True 'für Autofilter

 Next i
  
  Worksheets("" & DatePart("ww", Date, vbMonday, vbFirstFourDays)).Tab.ColorIndex = 3
  
 End Sub

Kann mir jemand sagen, wo der Fehler liegt?

14 Antworten

0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo,

wenn ein Fehler auftaucht, wird ja auch eine Zeile gelb markiert. Welche Zeile produziert denn den Fehler?

Wenn ich deinen Code in einer Testdatei ausführe funktioniert er einwandfrei. Vom aktuellen Datum ausgehend markiert er ja die Tabelle mit dem Name 5. Gibt es die Tabelle und wenn ja, ist der Name richtig?

Gruß

M.O.
0 Punkte
Beantwortet von raisix Mitglied (287 Punkte)

Vielen Dank für die Hilfe.

Ja er markiert das Blatt mit der Bezeichnung "5" beim Öffnen rot.

Außerdem wird zu Beginn der Hinweistext angezeigt.

Danach folgt die Fehlermeldung. Ebenfalls beim Schließen.

Er zeigt an, dass der Fehler in Zeile 2 liegt:

Worksheets("" & DatePart("ww", Date, vbMonday, vbFirstFourDays)).Tab.ColorIndex = xlNone

Seltsam ist, dass alles soweit funktioniert, jedoch die Fehlermeldung ausgegeben wird.

0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)

Hallo,

dein Code funktioniert in meiner Testmappe einwandfrei. Der Fehler liegt also irgendwo in deiner Datei.

Lösche mal den Code aus dem VBA-Projekt der Arbeitsmappe und füge die Codes einzeln neu ein.

Ansonsten kannst du ja mal die Mappe (ohne Daten) hier hochladen. Eine Anleitung findest du dazu hier.

Gruß

M.O.

0 Punkte
Beantwortet von raisix Mitglied (287 Punkte)
Ich habe nochmal von vorne angefangen. Es scheint ein Problem mit dem Punkt "Arbeitsmappe schützen" zu geben. Sobald ich dieses aktiviere, taucht der Fehler auf. Wie kann ich das ändern?

(Ich lade sonst später eine Tabelle hoch, wenn es keine Lösung gibt)
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)

Hallo,

du könntest mal den folgenden Code probieren. Hier wird der Blattschutz nur dann aktiviert, wenn das Blatt nicht bereits geschützt ist:

Sub Workbook_Open()
 Dim i As Long
 
 MsgBox "MUSTERTEXT.", 0, "Hinweis"
 
 For i = 1 To Worksheets.Count
  With Worksheets(i)
   If .ProtectContents = False Then
     .Protect userinterfaceonly:=True, Password:="Passwort"
     .EnableOutlining = True 'für Gliederung
     .EnableAutoFilter = True 'für Autofilter
   End If
  End With
 Next i
 
  Worksheets("" & DatePart("ww", Date, vbMonday, vbFirstFourDays)).Tab.ColorIndex = 3
 
 End Sub


Gruß

M.O.

0 Punkte
Beantwortet von

Damit ist das Problem leider nicht gelöst, dass ich die gesamte "Arbeitsmappe schützen" möchte.

(Danke für den Hinweis mit dem Upload. Das ist ja nicht leicht zu finden)

Im Anhang also eine Test-Datei mit dem Fehler.

http://supportnet.de/forum/?qa=blob&qa_blobid=5834888146784715437

+1 Punkt
Beantwortet von beverly_ Experte (3.3k Punkte)

Hi,

deine Arbeitsmappe ist geschützt - deshalb lässt sich die Farbe des Tabellenreiters nicht ändern. Du musst also zuerst den Mappenschutz aufheben, dann deinen Code ausführen und anschließend den Mappenschutz wieder setzen.

Ich würde außerdem die Farbe gleich im Schleifendurchlauf setzen:

Sub Workbook_Open()
    MsgBox "MUSTERTEXT.", 0, "Hinweis"
    Dim i As Long
    ' zuerst Mappenschutz aufheben !!!
    '.....
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = CStr(DatePart("ww", Date, vbMonday, vbFirstFourDays)) Then
            Worksheets(1).Tab.ColorIndex = 3
        End If
        Worksheets(i).Protect userinterfaceonly:=True, Password:="Passwort"
        Worksheets(i).EnableOutlining = True 'für Gliederung
        Worksheets(i).EnableAutoFilter = True 'für Autofilter
    Next i
    ' Mappenschutz wieder setzen
    '.....
End Sub


Bis später, Karin

0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)

Oh Mann,

Arbeitsmappe geschützt! Das hatte ich völlig überlesen blushangry. Na wenigstens hat Karin die Frage richtig gelesen.

Gruß

M.O.

0 Punkte
Beantwortet von raisix Mitglied (287 Punkte)

Oh Mann! Stimmt cheeky. Totaler Denkfehler.

Jetzt funktioniert es super.

Vielen Dank für die kompetente und freundliche Hilfe von euch :)

Hier der Code:

Sub Workbook_Open()
    MsgBox "MUSTERTEXT.", 0, "Hinweis"
    Dim i As Long
   
    ActiveWorkbook.Unprotect "Passwort" ' Schutz aufheben
   
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = CStr(DatePart("ww", Date, vbMonday, vbFirstFourDays)) Then
            Worksheets(1).Tab.ColorIndex = 3
        End If
        Worksheets(i).Protect userinterfaceonly:=True, Password:="Passwort"
        Worksheets(i).EnableOutlining = True 'für Gliederung
        Worksheets(i).EnableAutoFilter = True 'für Autofilter
    Next i
      
   ActiveWorkbook.Protect "Passwort" ' Schützen
          
End Sub
 

+1 Punkt
Beantwortet von beverly_ Experte (3.3k Punkte)
ausgewählt von raisix
 
Beste Antwort

Mir ist gerade noch etwas aufgefallen: wenn die Registerfarbe geändert wird muss sie natürlich auch für das zuvor gefärbte Tabellenblatt zurückgesetzt werden - du müsstest den Code also noch dahingehend erweitern

        If Worksheets(i).Name = CStr(DatePart("ww", Date, vbMonday, vbFirstFourDays)) Then
            Worksheets(1).Tab.ColorIndex = 3
        Else
            Worksheets(1).Tab.ColorIndex = xlNone
        End If

Bis später, Karin

...