AW: Arbeitsmappenschutz aufheben im Worksheet_Change
27.10.2019 14:33:16
EasyD
Also in irgendeiner Form hängt das mit dem Worksheet_Change zusammen
Einzeln laufen beide Codes Problemlos
Ich will die aber bei Änderung der Zelle CellsBuch ausführen, je nachdem ob "ja" oder "nein"
Hier mal der Ganze Code, ist noch eine ziemliche Baustelle, alles was noch nicht läuft ist auskommentiert:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim CellsE As Range, CellsF As Range, CellsG As Range, CellsGes As Range, CellsIcon As Range, _
CellsImage As Range, CellsAS As Range, CellsBuch As Range, CellsoB As Range, CellsMiete As Range
''''Dim tabArray As Variant
''''Dim i As Long
'Zellbereiche definieren
Set CellsE = Range("E84:E88, E91:E95")
Set CellsF = Range("F84:F88, F91:F95")
Set CellsG = Range("G84:G88, G91:G95")
Set CellsGes = Range("E84:G88, E91:G95")
Set CellsIcon = Range("Y11")
Set CellsImage = Range("BG25") 'Vorschau auf das Berechnungsergebnis
Set CellsAS = Range("AL17, AQ17") 'AuswahlAS1 und AuswahlAS2
Set CellsBuch = Range("G189") 'Auswahl Buchungsdaten ja/nein im Menü
Set CellsoB = Range("BG25")
''''' _
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'''''Tabreihenfolge festlegen
''''tabArray = Array("Y7", "Y9", "Y11", "X17", "Y19")
''''For i = LBound(tabArray) To UBound(tabArray)
'''' If tabArray(i) = Target.Address("X21") Then
'''' If i = UBound(tabArray) Then
'''' Me.Range(tabArray(LBound(tabArray))).Select
'''' Else
'''' Me.Range(tabArray(i + 1)).Select
'''' End If
'''' End If
''''Next i
''''' _
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
ActiveSheet.Shapes.Range(Array("Picture 9")).Visible = CellsIcon ""
ActiveSheet.Shapes.Range(Array("Vorschau")).Visible = CellsImage "nein"
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
If Target.Interior.Color = 9671679 Then
Call Protect_off
Target.Interior.ColorIndex = xlNone
Call Protect_on
End If
'xxxxxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
If Not Intersect(CellsGes, Target) Is Nothing Then
'Wenn Änderungen in Spalte E:
If Not Intersect(CellsE, Target) Is Nothing Then
Call Protect_off
Application.EnableEvents = False
If Not Application.Intersect(Target, Range("A1:A6,B1:B5")) Is Nothing Then
Target.Interior.ColorIndex = ((Target.Interior.ColorIndex = xlNone) * -3)
End If
Cancel = True
With CellsE.Interior
.Pattern = xlNone 'kein Hintergrund
End With
CellsF.ClearContents
CellsG.ClearContents
CellsF.Locked = True
CellsG.Locked = True
With CellsF.Interior
.Color = 15652797 'Hintergrund einfärben
End With
With CellsG.Interior
.Color = 15652797
End With
Application.EnableEvents = True
Call Protect_on
End If
'Wenn Änderungen in Spalte F:
If Not Intersect(CellsF, Target) Is Nothing Then
Call Protect_off
Application.EnableEvents = False
With CellsF.Interior
.Pattern = xlNone
End With
CellsE.ClearContents
CellsG.ClearContents
CellsE.Locked = True
CellsG.Locked = True
With CellsE.Interior
.Color = 15652797
End With
With CellsG.Interior
.Color = 15652797
End With
Application.EnableEvents = True
Call Protect_on
End If
'Wenn Änderungen in Spalte G:
If Not Intersect(CellsG, Target) Is Nothing Then
Call Protect_off
Application.EnableEvents = False
With CellsG.Interior
.Pattern = xlNone
End With
CellsE.ClearContents
CellsF.ClearContents
CellsE.Locked = True
CellsF.Locked = True
With CellsE.Interior
.Color = 15652797
End With
With CellsF.Interior
.Color = 15652797
End With
Application.EnableEvents = True
Call Protect_on
End If
If Application.CountA([E84:G88, E91:G95]) = 0 Then
Call Protect_off
CellsE.Locked = False
CellsF.Locked = False
CellsG.Locked = False
With CellsE.Interior
.Pattern = xlNone
End With
With CellsF.Interior
.Pattern = xlNone
End With
With CellsG.Interior
.Pattern = xlNone
End With
Call Protect_on
End If
End If
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
If Not Intersect(CellsAS, Target) Is Nothing Then
If Not IsEmpty(Range("AL17").Value) And Range("AL17").Value = Range("AQ17").Value Then
Call MsgBox("Sie haben die gleiche Auswahl für Antragsteller 1 und für _
Antragsteller 2 getroffen! Sind Sie sicher?", vbQuestion, "Warnung")
End If
End If
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
If Not Intersect(CellsoB, Target) Is Nothing Then
If CellsoB.Value = "nein" Then
UF_Erlass.Show
End If
End If
''''''xxxxxxxxxxxxxxx Das Blatt mit den Buchungsdaten einblenden, wenn Option gewählt: _
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
If Not Intersect(CellsBuch, Target) Is Nothing Then
Call ProtectMap_off
Sheets("Buchungsdaten").Visible = CellsBuch.Value "nein"
Call ProtectMap_on
End If
Set CellsE = Nothing: Set CellsF = Nothing: Set CellsG = Nothing: Set SellGes = Nothing: Set _
CellsIcon = Nothing: Set CellsAS = Nothing: Set CellsBuch = Nothing: Set CellsoB = Nothing
End Sub