Registriert seit: 27.04.2014
Version(en): Privat: Office Home & Business 2019 / Arbeit: MS365
Hallo Uwe,
vielen Dank für den Code, den ich gleich getestet habe! Dieser funktioniert SUPER, allerdings bei mir nur wenn ich in A2 etwas eintrage, das liegt wahrscheinlich daran, dass die Textlänge für die Spalte A nur in AC2 zu finden ist!
Der Einfachheit Halber und weil ich von einer Lösung ohne VBA ausgegangen bin, habe ich nur für Spalte A angefragt! SORRY!
Folgendes möchte ich noch ergänzen:
1. Für die Spalte A aber erst ab A3 soll die Datenprüfung stattfinden aufgrund der Textlänge die in AC2(Steht immer fest hier für Spalte A) steht.
2. Für die Spalte B aber erst ab B3 soll die Datenprüfung stattfinden aufgrund der Textlänge die in AD2(Steht immer fest hier für Spalte B) steht usw.
3. Das ganze entsprechend weiterführen für alle weiteren Spalten bis
Für die Spalte N aber erst ab N3 soll die Datenprüfung stattfinden aufgrund der Textlänge die in AP2(Steht immer fest hier für Spalte N) steht
Vielen Dank im Voraus
LG
Alexandra
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
Hallo Alexandra,
teste mal damit:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngL As Range
On Error Resume Next
Application.EnableEvents = False
If Not Application.Intersect(Target, Range("A3:N" & Rows.Count), ActiveSheet.UsedRange) Is Nothing Then
Set rngL = Cells(2, Target.Column + 28)
With Target.Validation
.Delete
.Add Type:=xlValidateTextLength, AlertStyle:=xlValidAlertStop, _
Operator:=xlLessEqual, Formula1:=CStr(rngL.Value)
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = "ACHTUNG, maximale Textlänge von " & rngL.Value & " überschritten!"
.ShowInput = True
.ShowError = True
End With
End If
Application.EnableEvents = True
End Sub
Gruß Uwe
Registriert seit: 11.04.2014
Version(en): '97 bis 2016; 365
Hallo Alexandra,
sorry, ich hatte einen Arzttermin und bin gerade erst wieder zur Haustüre rein.
Aber Du bist ja in allerbesten Händen gelandet.
Registriert seit: 27.04.2014
Version(en): Privat: Office Home & Business 2019 / Arbeit: MS365
Hallo Uwe,
das funktioniert super!!! :) Eine Frage noch, die Spalten M bis AP sind in der Datei ausgeblendet, dann funktioniert dein Code nicht, nur wenn die Spalten M bis AP eingeblendet sind.
Gibt es eine Möglichkeit dass es auch bei ausgeblendeten Spalten M bis AP funktioniert?
Vielen lieben Dank
LG
Alexandra
Registriert seit: 27.04.2014
Version(en): Privat: Office Home & Business 2019 / Arbeit: MS365
Hallo Uwe,
ich habe den/mein Fehler gefunden! Es waren nicht die Ausgeblendeten Spalten sondern der Schreibschutz! :20:
Nun funktioniert es perfekt!! :)
Vielen lieben Dank nochmals
LG
Alexandra
Registriert seit: 27.04.2014
Version(en): Privat: Office Home & Business 2019 / Arbeit: MS365
(21.10.2016, 11:41)Kuwer schrieb: Hallo Alexandra,
teste mal damit:Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngL As Range
On Error Resume Next
Application.EnableEvents = False
If Not Application.Intersect(Target, Range("A3:N" & Rows.Count), ActiveSheet.UsedRange) Is Nothing Then
Set rngL = Cells(2, Target.Column + 28)
With Target.Validation
.Delete
.Add Type:=xlValidateTextLength, AlertStyle:=xlValidAlertStop, _
Operator:=xlLessEqual, Formula1:=CStr(rngL.Value)
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = "ACHTUNG, maximale Textlänge von " & rngL.Value & " überschritten!"
.ShowInput = True
.ShowError = True
End With
End If
Application.EnableEvents = True
End Sub
Gruß Uwe
Hallo Uwe,
der Code funktioniert prima, es ist jetzt nur
ein Problem aufgetreten und zwar kann ich keine Werte mehr mit STRG+C und STRG+V kopieren und einfügen!? Es ist nur in dieser Datei in den anderen Dateien geht es!
Hast du eine Idee woran das liegt?
Vielen Dank im Voraus
LG Alexandra
Registriert seit: 27.04.2014
Version(en): Privat: Office Home & Business 2019 / Arbeit: MS365
(21.10.2016, 11:41)Kuwer schrieb: Hallo Alexandra,
teste mal damit:Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngL As Range
On Error Resume Next
Application.EnableEvents = False
If Not Application.Intersect(Target, Range("A3:N" & Rows.Count), ActiveSheet.UsedRange) Is Nothing Then
Set rngL = Cells(2, Target.Column + 28)
ActiveSheet.Unprotect Password:="999"
With Target.Validation
.Delete
.Add Type:=xlValidateTextLength, AlertStyle:=xlValidAlertStop, _
Operator:=xlLessEqual, Formula1:=CStr(rngL.Value)
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = "ACHTUNG, maximale Textlänge von " & rngL.Value & " überschritten!"
.ShowInput = True
.ShowError = True
End With
End If
Application.EnableEvents = True
ActiveSheet.Protect Password:="999"
End Sub
Gruß Uwe
Hallo Uwe,
ich habe das Problem gefunden, es ist wieder der Schreibschutz! :) Habe ich oben rot markiert!
Wenn ich STRG-C drücke dann blinkt/kreist der Zellenrand, aber sobald ich die Zelle verlasse dann hört das blinken/kreisen auf! Wenn ich die zwei Zeilen auskommentiere im Code dann geht es, aber ich brauche diesen Schreibschutz! Was kann ich da machen?
Vielen Dank
VG
Alexandra
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
Hallo Alexandra,
wie Du selbst festgestellt hast, widersprechen sich Deine Anforderungen.
Unabhängig davon kann man durch Copy/Paste die Längenbegrenzung austricksen. Wozu soll das also gut sein?
Gruß Uwe