das mit Option Explicit liegt an Deinem Code. Ich arbeite mich da nicht ein.
Private Sub Worksheet_Change(ByVal Target As Range)
'* H. Ziplies *
'* 21.06.15 *
'* erstellt von HajoZiplies@web.de *
'* http://Hajo-Excel.de/
If Environ("USERNAME") = "Hajo_Zi" Then
' eingeschränktte Rechte
Dim RaBereich As Range ' Variable für Bereich
Dim RaZelle As Range ' Variable für Zelle
' Bereich der Wirksamkeit, der nicht gewählt werden darf
Set RaBereich = Range("L22:M39, O21:O26")
' noch mehr Bereiche
'Set RaBereich = Union(Range("C11:AG11 , C13:AG13, C15:AG15 , C17:AG17"), _
' Range("C35:AE35, C37:AE37, C43:AG43, C45:AG45 , C47:AG47 , C49:AG49"), _
' Range("C67:AF67 , C69:AF69 , C75:AG75 , C77:AG77 , C79:AG79 , C81:AG81"), _
' Range("C99:AF99 , C101:AF101, C107:AG107 , C109:AG109 , C111:AG111"), _
' Range("C127:AG127 , C129:AG129 , C131:AG131 , C133:AG133 , C139:AF139"), _
' Range("C155:AG155, C157:AG157 , C159:AG159 , C161:AG161 , C163:AG163"), _
' Range("C179:AF179 , C181:AF181, C187:AG187 , C189:AG189 , C191:AG191"))
' ab Vesion XP braucht der Schutz nicht aufgehoben werden
' Formatierung bei Schutz kann über Dialog Schutz eingestellt werden
' Zelle die in dem Bereich liegen auf die Variable schreiben
' damit werden nur noch die Zellen bearbeitet die im vorgegeben Bereich liegen
' jede Zelladresse ist einzeln angegeben
Set RaBereich = Intersect(RaBereich, Target)
If Not RaBereich Is Nothing Then
Application.EnableEvents = False
Range("A1").Select ' Zelle die gewählt werden darf
Application.EnableEvents = True
End If
Set RaBereich = Nothing ' Variable leeren
Else
Else
ActiveSheet.Unprotect Password:="1234"
Dim objRange As Range, objCell As Range
Set objRange = Intersect(Target, Columns(13)) 'wenn sich in Spalte "m" (13)etwas ä _
_
ndert...
If Not objRange Is Nothing Then
Application.EnableEvents = False
For Each objCell In objRange
If Not IsEmpty(objCell.Value) Then
Range(Cells(objCell.Row, 2), Cells(objCell.Row, 20)).Copy '...wird der _
_
Bereich "B" - "N" markiert...
With Worksheets("Mängelliste")
Call .Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 22) _
.PasteSpecial(Paste:=xlPasteValues) '...und ab Spalte "V" in _
Zeile 2 eingetragen
End With
End If
Next
With Application
.CutCopyMode = False
.EnableEvents = True
End With
Set objRange = Nothing
End If
'geht zur letzten aktiven Zelle und Selektiert diese
Set rngLetzteZelle = Target
Target.Select
' scrollt Blatt in Ausgangsposition (Vertikal)
'ActiveWindow.ScrollColumn = 1
'ActiveSheet.Protect Password:="1234"
'################################################################################### _
_
'Abfrage: "wenn kein Foto..." _
For Each zelle In Range("R9:R3008") _
If zelle.Text = "#WERT!" Then 'wenn Fehler in Spalte "R"(kein Foto)vorhanden- _
_
MsgBox #
If MsgBox("Kein Foto gefunden! Wollen sie tatsächlich ohne Foto senden?", _
vbYesNo + vbDefaultButton1, "Achtung!") = vbYes Then '#
ActiveCell.Offset(0, -6).Select 'Selektiert & löscht in Spalte "Foto" _
die Grüne Farbe #
With Selection.Interior _
.Pattern = xlNone _
.TintAndShade = 0 _
.PatternTintAndShade = 0 _
End With _
MsgBox "Bitte wiederholen sie die letzten Schritte ab 'Status'!", _
vbOKOnly, "Info" '#
Cells(Rows.Count, 16).End(xlUp).Select ' Selektiert letzten eintrag in _
_
Spalte "P" und löscht diesen #
Selection.ClearContents _
Unload Werkstatt 'schließt UF _
Else _
MsgBox "Fragen Sie beim Portier nach, ob es tatsächlich kein Foto gibt!" _
_
, vbOKOnly, "Achtung" '#
Cells(Rows.Count, 16).End(xlUp).Select ' Selektiert letzten eintrag in _
_
Spalte "P" und löscht diesen #
Selection.ClearContents _
Unload Werkstatt 'schließt UF _
Exit Sub _
End If _
End If _
Next _
ActiveSheet.Protect Password:="1234" _
'################################################################################### _
_
Dim Bereich As Range _
If Environ("USERNAME") = "P123456" Or _
Environ("Username") = "P1234560" Then Exit Sub
'Freigabe in der Reihenfolge: Beranek,Ofner,Stinglmair,Freinschlag,Füreder, _
Schuhmann,Dumfart,Eheim,Strotmann,Miny,Edlinger,Gasperina * _
Set Bereich = Range("L9:N3008") _
If Intersect(Target, Bereich) Is Nothing Then _
Else _
'MsgBox "Sie sind nicht berechtigt, änderungen" & vbCr & "in der Mängelliste _
durchzuführen!!!", vbOKOnly, "Beranek Helmut informiert:" '*
Application.EnableEvents = False _
Application.Undo _
Application.EnableEvents = True _
End If
End If
End Sub
Gruß Hajo