AW: Eingabe in geschützte Zelle ermöglichen
11.03.2006 14:32:22
Konni
Hallo K.Rola,
inzwischen habe ich aus der "unendlichen Geschichte" entnommen, dass Du weiblicher Natur bist! Küsschen für Deine Arbeit!!
Ich habe nun nur noch zwei Probleme:
Problem 1 - Zelle per Doppelklick eingabefähig machen
In der Tabelle wird in einer anderen Spalte auch auf Zellen doppelgeklickt, worauf in einer MsgBox der Kommentar zu dieser Zelle aus einer anderen Tabelle angezeigt wird. Ich bekomme es einfach nicht hin, Deinen Code ohne Kollision unterzubringen. Habe alles ausprobiert, was mir eingefallen ist. Nachstehend die beiden Original-Codes.
Dein Code:
Option Explicit
Dim dblOldValue As Double
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'Code freundlicherweise von K.Rola
'Zellbereich anpassen
If Not Intersect(Target, [G14:G1000]) Is Nothing And Target.Locked Then
Me.Unprotect Password:="Passwort"
Target.Locked = False
'Wenn die Farbe nicht gewünscht ist die nächste Zeile löschen
Target.Interior.ColorIndex = 15
Me.Protect Password:="Passwort"
Cancel = True
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'Zellbereich anpassen
If Not Intersect(Target, [G14:G1000]) Is Nothing And Not Target.Locked Then
Me.Unprotect Password:="Passwort"
If IsNumeric(Target) And Target > 0 Then
'Wenn die Farbe nicht gewünscht ist die nächste Zeile löschen
Target.Interior.ColorIndex = -4142
Else
Target = dblOldValue
End If
If Not Target.Locked Then Target.Locked = True
Me.Protect Password:="Passwort"
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, [G14:G1000]) Is Nothing And Target.Locked Then
dblOldValue = Target.Value
End If
End Sub
Der andere Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column <> 5 Or Target.Row < 14 Then Exit Sub
Cancel = True 'cancel = true unterdrückt den Editmodus der Zelle
Set c = Worksheets(2).Range("d12:d1000").Find(Cells(Target.Row, Target.Column))
Text = ""
For x = 1 To 5
If Trim(Worksheets(2).Cells(c.Row + x, c.Column)) = "" Then Exit For
Text = Text & vbLf & Worksheets(2).Cells(c.Row + x, c.Column)
Next x
A = MsgBox(Text, vbOKOnly, Worksheets(2).Cells(c.Row, c.Column))
End Sub
'Code ermöglicht Anzeige Kommentar unter Zeilenüberschrift der Stellungnahme BÜ _
in MsgBox Nachtragsübersicht. 'Code freundlicherweise von Rainer
Problem 2 - Verschleiertes Passwort
Ich bekomme die Userform statt InPutBox nicht in nachstehenden Code ohne Fehlermeldung.
Sub Grunddaten_EK_löschen()
ActiveWorkbook.Save
Dim s As String
Const passw = "Passwort"
s = InputBox("Geben Sie das Passwort ein")
If s = passw Then MsgBox "Bitte tätigen Sie nach dem Löschen Ihre Eingaben" Else _
Application.DisplayAlerts = False: MsgBox _
"Sie haben ein falsches Passwort eingegeben! (Diese Funktion ist nur für den Einkauf bestimmt)": Exit Sub
If MsgBox("Wollen Sie wirklich alle Einträge löschen?", vbYesNo, "Grunddaten EK löschen") = vbNo Then Exit Sub
If MsgBox("Sind Sie sich wirklich sicher?" & vbLf & vbLf & "Hinweis:" & vbLf & "Falls Sie jetzt mit ""Ja"" bestätigen und doch nicht löschen wollten, so schließen Sie die Tabelle, ohne diese vorher abzuspeichern!", vbYesNo, "Sicherheitsabfrage") = vbNo Then Exit Sub
Range("G45:M45").Select
Selection.ClearContents
.....
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
UserInterfaceOnly:=True, Password:="Passwort"
End Sub
Liebe K.Rola, vielen, vielen Dank für Deine Bemühungen. (Boris wird hoffentlich ein Nachsehen haben, dass ich mich so stümperhaft anstelle!)
Viele Grüße
Konni