AW: @Josef Ehrensberger
01.07.2006 15:27:30
Fritz
Hallo Sepp,
Nachstehend ist der gesamte Code aus "Diese Arbeitsmappe" wiedergegeben.
Da ich diesen Code aus diesem Forum nach und nach "zusammengetragen" habe, befürchte ich, dass sich da etwas "in die Quere" kommt. Beim Öffnen der Datei kommt eine Fehlermeldung und es wird nicht mehr die Tabelle "Hauptmenu" aktiviert. Es wäre schön, wenn das ohne Fehlermeldung wieder möglich wäre und dennoch die mit deiner Hilfe mögliche Auflistung der "Dateien mit Zahlen" (in Tabelle1) und deren Verschieben/Kopieren möglich wäre.
Das funktioniert aus der Datei mittlerweile bestens (nochmals: eine Super-Lösung, die Du hochgeladen hast!).
Danke!!!
Gruß
Fritz
Option Explicit
Private Sub Workbook_Open()
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:="XXX"
Tabelle1.Worksheet_Activate
'ActiveSheet.Protect Password:="XXX"
PlayWave
Worksheets("Hauptmenu").Activate
ActiveSheet.Unprotect Password:="XXX"
Range("C2").Activate
Application.ScreenUpdating = True
ActiveSheet.Protect Password:="XXX"
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Dim WS As Worksheet
For Each WS In ThisWorkbook.Sheets
With WS
.Protect Password:="XXX"
End With
Next
End Sub
Private Sub Workbook_SheetDeactivate(ByVal sh As Object)
Dim rng As Range, r As Range
Dim bCheck As Boolean
With sh
If TypeName(sh) = "Worksheet" Then
.Unprotect "XXX"
On Error Resume Next
Set rng = .UsedRange.SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If Not rng Is Nothing Then
For Each r In rng
On Error Resume Next
bCheck = r.FormatConditions(1).Formula1 <> ""
On Error GoTo 0
If bCheck Then
If Not r.Locked And r.Interior.ColorIndex = 36 And Len(r) > 0 Then
r.Locked = True
ElseIf r.Interior.ColorIndex = 36 And Len(r) = 0 Then
r.Locked = False
End If
End If
Next
End If
.Protect "XXX"
End If
End With
End Sub