Fast geschafft und doch gescheitert....

Hallo zusammen,

Ich habe bereits einiges durchgelesen allerdings find ich für mich keine passende Lösung :/
Nach langem hin und her, funktionierten endlich alle meine eingesetzten Makros.
Stolz wie Oskar weise ich diversen Benutzergruppen Berechtigungen zu und hoffe endlich fertig zu sein. (Inklusive Blattschutz)
Falsch gedacht die Makros starten einfach nicht mehr selbständig bzw. überhaupt nicht mehr und durch die diversen Berechtigungen weis ich mir leider auch nicht mehr zu helfen.....
Wie muss ich den Code verändert?, OHNE das Passwort im Makro zu hinterlegen UND gleichzeitig die einzelnen Berechtigungsstufen zu erhalten?
Könnt Ihr mir weiter helfen? :)
Ich wäre euch sehr dankbar.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range
Dim c As Range
Set Bereich = Range("A7:Q66")
For Each c In Target.Cells
If Not Intersect(c, Bereich) Is Nothing Then
If IsEmpty(c) Then
On Error Resume Next
Application.EnableEvents = False
c.Formula = Sheets("Formelblatt").Range(c.Address).Formula
Application.EnableEvents = True
On Error GoTo 0
End If
End If
Next c
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngDV As Range
Application.EnableEvents = False
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo 0
If rngDV Is Nothing Then Exit Sub
If Intersect(Target, rngDV) Is Nothing Then
ActiveWindow.Zoom = 90
Else
ActiveWindow.Zoom = 130
End If
Application.EnableEvents = True
End Sub



Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)

If Not Intersect(Target, Range("A4:A66")) Is Nothing Then

Target = IIf(Target = "", "x", IIf(Target = "x", "", ""))

Cancel = True

End If

End Sub

Ich hab es jetzt so versucht jedes mal den Blattschutz im Makro aufzuheben und erneut zu setzten leider erfolglos......
Kann mir jemand sagen, was ich da falsch mache?
Beim debuggen zeigt er mir eine Fehlermeldung bei dieser Zeile:
ActiveSheet.Unprotect "Test"
Wie muss ich es denn ändern damit dies Funktioniert?

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect "Test"
Dim Bereich As Range
Dim c As Range
Set Bereich = Range("A7:Q66")
For Each c In Target.Cells
If Not Intersect(c, Bereich) Is Nothing Then
If IsEmpty(c) Then
On Error Resume Next
Application.EnableEvents = False
c.Formula = Sheets("Formelblatt").Range(c.Address).Formula
Application.EnableEvents = True
On Error GoTo 0
End If
End If
Next c
With ActiveSheet
.EnableSelection = xlUnlockedCells
.Protect Password:="Test", DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveSheet.Unprotect "Test"
Dim rngDV As Range
Application.EnableEvents = False
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo 0
If Not rngDV Is Nothing Then
If Intersect(Target, rngDV) Is Nothing Then
ActiveWindow.Zoom = 90
Else
ActiveWindow.Zoom = 130
End If
End If
Application.EnableEvents = True
With ActiveSheet
.EnableSelection = xlUnlockedCells
.Protect Password:="Test", DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
ActiveSheet.Unprotect "Test"
If Not Intersect(Target, Range("A4:A66")) Is Nothing Then
Target = IIf(Target = "", "x", IIf(Target = "x", "", ""))
Cancel = True
End If
With ActiveSheet
.EnableSelection = xlUnlockedCells
.Protect Password:="Test", DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
End Sub

Fast geschafft und doch gescheitert....

Forumthread: Fast geschafft und doch gescheitert....

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Fast geschafft und doch gescheitert....

Forumthread: Fast geschafft und doch gescheitert....

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread