Zelltext der bei anklicken verschwindet

Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Address(0, 0) = "A1" And Target.Value = "[ Bsp: Name, Vorname]" Then Application.EnableEvents = False Target.Value = "" Application.EnableEvents = True Else If [A1].Value = "" Then [A1].Value = "[ Bsp: Name, Vorname]" End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Dim RaBereich As Range ' Variable für Bereich Dim RaZelle As Range ' Variable für Zelle Private Sub Worksheet_Change(ByVal Target As Range) Set RaBereich = Intersect(RaBereich, Target) If Not RaBereich Is Nothing Then 'ActiveSheet.Unprotect ("Passwort") For Each RaZelle In RaBereich If RaZelle "" Then RaZelle.Font.ColorIndex = xlAutomatic End If Next RaZelle End If End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) Set RaBereich = Range("A1:M39, O21:O26") ' Bereich der Wirksamkeit ' 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 'ActiveSheet.Unprotect ("Passwort") Application.EnableEvents = False For Each RaZelle In RaBereich If RaZelle = "" Then With RaZelle .Value = "[ Bsp: Name, Vorname]" .Font.Color = 12632256 End With End If Next RaZelle Application.EnableEvents = True End If End Sub

Hallo,
@ Daniel: An so eine einfach Version habe ich gar nicht gedacht. Ich werde das mal überprüfen und schauen ob die Anwender damit zufrieden sind.
@ Hajo_Zi: Dank für den aufwendigen Code. Ist es normal, das ich erst in alle Zellen einmal klicken muss, damit der Beispieltext erscheint? Es ist allerdings nicht notwendig, dass in allen Zellen das gleiche steht. Es wird eher so sein, das in einer Zeile [Name, Vorname] steht in der nächsten dann [Straße, Hausnummer], [Postleitzahl, Wohnort]. So in dieser Art ist das Formular aufgebaut.
Was aber super klappt ist der Farbwechsel zwischen Grau und schwarz.
Vielleicht gibt es hier noch eine andere VBA Möglichkeit. Ich möchte es gern damit probieren.
Danke für eure Unterstützung.
Gruß Dennis

Option Explicit Dim ZelleAlt As Range Const Abstand As Long = 10 Private Sub Worksheet_Change(ByVal Target As Range) Dim Zelle As Range If Intersect(Target, Range("EingabeZellen")) Is Nothing Then Exit Sub For Each Zelle In Intersect(Target, Range("EingabeZellen")) If Zelle.Value = "" Then Application.EnableEvents = False Zelle.Value = Zelle.Offset(0, Abstand).Value Application.EnableEvents = True End If Next End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not ZelleAlt Is Nothing Then If ZelleAlt.Value = "" Then Application.EnableEvents = False ZelleAlt.Value = ZelleAlt.Offset(0, Abstand).Value Application.EnableEvents = True End If End If Set ZelleAlt = Nothing If Target.CountLarge > 1 Then Exit Sub If Intersect(Target, Range("EingabeZellen")) Is Nothing Then Exit Sub If Left(Target.Value, 1) = "[" Then Application.EnableEvents = False Target.ClearContents Application.EnableEvents = True Set ZelleAlt = Target End If End Sub

Hallo Daniel,
muss mich noch mal melden.
Wie stelle ich es an, dass ich noch eine zweite Spalte mit Vorgaben belegen will.
Ich kann ja nicht zwei Worksheet_Change erstellen und einfach die beiden Prozeduren hintereinander ausführen klappt auch nicht.
Das war mein Versuch aber da passiert in dem Datum-Feld leider gar nichts.
Option Explicit
Dim ZelleAlt As Range
Const Abstand As Long = 4
Dim ZelleAlt_Datum As Range
Const Abstand_Datum As Long = 4

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
If Intersect(Target, Range("EingabeZellen")) Is Nothing Then Exit Sub
For Each Zelle In Intersect(Target, Range("EingabeZellen"))
If Zelle.Value = "" Then
Application.EnableEvents = False
Zelle.Value = Zelle.Offset(0, Abstand).Value
Application.EnableEvents = True
End If
Next
If Intersect(Target, Range("Datum")) Is Nothing Then Exit Sub
For Each Zelle In Intersect(Target, Range("Datum"))
If Zelle.Value = "" Then
Application.EnableEvents = False
Zelle.Value = Zelle.Offset(0, Abstand_Datum).Value
Application.EnableEvents = True
End If
Next
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not ZelleAlt Is Nothing Then
If ZelleAlt.Value = "" Then
Application.EnableEvents = False
ZelleAlt.Value = ZelleAlt.Offset(0, Abstand).Value
Application.EnableEvents = True
End If
End If
Set ZelleAlt = Nothing
If Target.CountLarge > 1 Then Exit Sub
If Intersect(Target, Range("EingabeZellen")) Is Nothing Then Exit Sub
If Left(Target.Value, 1) = "[" Then
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
Set ZelleAlt = Target
End If
If Not ZelleAlt_Datum Is Nothing Then
If ZelleAlt_Datum.Value = "" Then
Application.EnableEvents = False
ZelleAlt_Datum.Value = ZelleAlt_Datum.Offset(0, Abstand_Datum).Value
Application.EnableEvents = True
End If
End If
Set ZelleAlt_Datum = Nothing
If Target.CountLarge > 1 Then Exit Sub
If Intersect(Target, Range("Datum")) Is Nothing Then Exit Sub
If Left(Target.Value, 1) = "[" Then
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
Set ZelleAlt_Datum = Target
End If
End Sub

Beliebteste Forumthreads (12 Monate)

Zelltext der bei anklicken verschwindet

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread