Geschützte Blätter verwirren Makros
05.08.2021 01:26:38
Norbert
habe ein Grosses Problem mit einer Datei. Würde BITTE eure Hilfe benötigen.
Ich habe 3 Bereiche die ich mit intesect und doubleclick ansprechen will. Aber jedes mal, wenn ich einen doppelklick mache und mein Makro mit Blattschutz durchläuft, ist das Target nicht mehr wo ich doppel geklickt habe, sondern das von einem anderen Blatt.
Es soll beim doppelklick eine userform geöffnet werden, die dann teilweise wieder makros enthält und dann dort zum beispiel uhrzeiten in das bestehende Target zurückgeben.
Das Problem habe ich nur, wenn die Blätter geschützt sind und während des eigentlichen Ablaufs geöffnet werden.
Ohne Blattschutz läuft es. Aber das ist für die Formeln tödlich bei den kommenden User.
Habe schon mehrere Varianten des Protect durch und mit Application.DisplayAlerts = False und Application.ScreenUpdating = False.
Alles kein Erfolg.
die AktiveCell oder die Target bekommen den Wert von einer anderen Tabelle, wo eine Zelle ganz wo anders markiert ist.
Die zu überwachende ist die Gesamtliste.
Werte kommen von anderen.
Werden teilweise mit der falschen Range in die richtige Gesamtliste oder gleich in die falsche Tabelle geschrieben.
Das sorgt natürlich für einen Saustall, wo man keinen Überblick mehr hat.
Datei kann ich nicht hochladen, da die knapp über 1 MB hat. leider.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Blattschutz_aus
Cancel = True
Dim i
'On Error GoTo ende
Blattschutz_aus
ActiveSheet.Unprotect
If Not Intersect(Target, Me.Range("A2:A1002")) Is Nothing Then 'Application.Intersect(Target, Me.Range("A2:A1002")) Is Nothing Then
ActiveSheet.Unprotect
'Sheets("Gesamtliste").Range("BY1").Value = Target.Address
'Sheets("Gesamtliste ").Select"
frm_Kalender.Show
'Blattschutz_aus
Alles_anzeigen_G
'Cancel = True
' Protect
Else
End If
Blattschutz_aus
If Not Intersect(Target, Me.Range("B:C")) Is Nothing Then 'Application.
'Unprotect
UserForm3.Label3.Caption = ActiveCell.Column
UserForm3.Label4.Caption = ActiveCell.Row
UserForm3.Show
i = ActiveCell.Row
i_Aktive_row_ = ActiveCell.Row
If Range("A" & i).Value = "" Then
If Range("B" & i).Value = Range("C" & i).Value Then
If Range("H" & i).Value = 0 Then
If Range("D" & i).Value = "" Then
Alles_anzeigen_G ' Sortieren
Else
End If
Else
End If
Else
End If
Else
End If
Else
End If
If Not Application.Intersect(Target, Me.Range("D2:D1002")) Is Nothing Then
'aktuelles_Ziel = Target.Address
'Blattschutz_aus
'MsgBox (aktuelles_Ziel)
'Unprotect
UserForm2.Label1.Caption = ActiveCell.Column
UserForm2.Label2.Caption = ActiveCell.Row
UserForm2.Show
Else
End If
ende:
'Cancel = True
Blattschutz_ein
End Sub
Sub Blattschutz_ein()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Exit Sub
Dim Blatt As Worksheet
For Each Blatt In ActiveWorkbook.Sheets
Blatt.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Next
'If Sheets("Gesamtliste").Range("AO1").Value = "x" Then
Exit Sub
' Else
'End If
Sheets("Gesamtliste").Protect UserInterfaceOnly:=True
Sheets("Druckvorschau").Protect UserInterfaceOnly:=True
Sheets("Übersicht").Protect UserInterfaceOnly:=True
Sheets("Optionen").Protect UserInterfaceOnly:=True
Sheets("Vorlagen").Protect UserInterfaceOnly:=True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub #############################################
Sub Blattschutz_aus()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim Blatt As Worksheet
For Each Blatt In ActiveWorkbook.Sheets
Blatt.Unprotect
Next
Exit Sub
Sheets("Gesamtliste").Unprotect
Sheets("Druckvorschau").Unprotect
Sheets("Übersicht").Unprotect
Sheets("Optionen").Unprotect
Sheets("Vorlagen").Unprotect
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Die Bereiche werden teilweise auch mit Change angesprochen....
#############################################################
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Blattschutz_aus
'On Error GoTo ende
Dim i
If Not Application.Intersect(Target, Me.Range("A:A")) Is Nothing Then
i = ActiveCell.Row
Range("AN" & i).Value = "o"
If ActiveCell.Value = "" Then
Range("AN" & i).Value = ""
Else
End If
If Range("A" & i).Value = "" Then
If Range("B" & i).Value = Range("C" & i).Value Then
If Range("H" & i).Value = 0 Then
If Range("D" & i).Value = "" Then
Alles_anzeigen_G ' Sortieren
'Range("A" & i).Select
Else
End If
Else
End If
Else
End If
Else
End If
Else
End If
If Not Application.Intersect(Target, Me.Range("D:D")) Is Nothing Then
'Dim RgNr As Variant
If Target.Value = "Werkstatt" Then
With Target.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
UserForm1.Show
Else
With Target.Interior
.ColorIndex = xlNone
.Pattern = xlSolid
End With
End If
'RgNr = Range("B6").Value'
'ActiveSheet.ListObjects("Tabelle6").Range.AutoFilter Field:=1, Criteria1:= _
' RgNr, Operator:=xlOr, Criteria2:="="
End If
ende:
Blattschutz_ein
Application.ScreenUpdating = True
End Sub
