Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
696to700
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
696to700
696to700
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

VBA: Abfrage, ob Gültigkeitsregel vorhanden

VBA: Abfrage, ob Gültigkeitsregel vorhanden
15.11.2005 11:16:00
Matthias
Da es in Excel 97 einen Bug gibt, durch den bei Auswahl aus einer Gültigkeitsliste kein Change-Event ausgelöst wird, möchte ich prüfen, ob bei einer Zelle eine Gültigkeitsregel (mit .InCellDropdown = true) definiert ist.
Leider hat keine Abfrage funktioniert:
- "isobject(Selection.Validation)" ist immer true
- "Selection.Validation is Nothing" ist immer false
- Sämtliche Eigenschaften des Validation-Objektes liefern entweder Werte, die keinen Aufschluss geben, oder führen zu Laufzeitfehler '1004' (Anwendungs- oder objektdefinierter Fehler).
Da ein Range-Objekt auch keine "HasValidation"-Eigenschaft hat, kann ich das nur mit einem "On Error Resume Next" abfangen.
Wenn jemand eine elegantere Lösung weiß, bitte melden!
Danke
Matthias

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA: Abfrage, ob Gültigkeitsregel vorhanden
15.11.2005 13:45:19
K.Rola
Hallo,
das ist einer der Fälle, wo es ohne eine On Error- Anweisung nicht geht.
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngValidation As Range
On Error GoTo ENDE
Set rngValidation = Cells.SpecialCells(xlCellTypeAllValidation)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, rngValidation) Is Nothing Then
If ActiveCell.Validation.InCellDropdown = True Then
Application.EnableEvents = False
'Statt der MsgBox hierhin schreiben, was dann passieren soll.
MsgBox "Dropdown!"
End If
End If
ENDE:
Application.EnableEvents = True
End Sub

Gruß K.Rola
Anzeige
AW: VBA: Abfrage, ob Gültigkeitsregel vorhanden
15.11.2005 15:56:31
Matthias
Danke für den Hinweis auf die SpecialCells-Methode. Dein Beispiel lässt sich aber noch in drei Punkten optimieren:
1) Durch die Intersect-Funktion ist die OnError-Anweisung überflüssig: Der If-Zweig wird ja nur ausgeführt, wenn eine Gültigkeitsregel vorhanden ist. Man muss daher nicht mehr mit einem Fehler rechnen.
2) Die Abfrage der Eigenschaft .InCellDropdown ist zu wenig, weil diese default auf TRUE gesetzt ist (auch bei Zahlen, Datum etc.). Man muss daher auch noch auf Typ 3 abfragen um nur Listenfelder zu bekommen.
3) Die SpecialCells-Methode ruft das SelectionChange-Event auf (lässt sich durch EnableEvents = FALSE in Excel 97 nicht unterdrücken). Mir ist das aufgefallen, weil mit diesem Code der Wechsel von einer Zelle zur anderen sichtbar Zeit verbraucht. Ich habe dann einen Zähler mitlaufen lassen: Das Event wird 355 mal rekursiv aufgerufen (vermutlich die Obergrenze rekursiver Aufrufe). Ich habe das mit einer Static-Variablen unterbunden.
So sieht der optimierte Code aus:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static IsRunning As Boolean
Dim rngValidation As Range
If IsRunning Then Exit Sub                    'rekursiven Aufruf unterbinden
IsRunning = True
Set rngValidation = Cells.SpecialCells(xlCellTypeAllValidation)
IsRunning = False
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, rngValidation) Is Nothing Then
If (ActiveCell.Validation.Type = 3) And ActiveCell.Validation.InCellDropdown = True Then
Application.EnableEvents = True
'Statt der MsgBox hierhin schreiben, was dann passieren soll.
MsgBox "Dropdown!"
Application.EnableEvents = True
End If
End If
End Sub

Danke für die Unterstützung
Matthias
Anzeige
Nachsatz:
15.11.2005 16:17:48
Matthias
Bin gerade draufgekommen, dass es ohne "On Error" doch riskant ist: Wenn keine Zelle eine Gültigkeitsregel hat, liefert die SpecialCells-Methode nicht Nothing zurück, sondern produziert einen Laufzeitfehler 1004 (der Fall ist in der Hilfe nicht beschrieben)
Wenn ich um das nicht herumkomme, werde ich es gleich auf die kurze Methode machen:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim TargetType As Integer
On Error Resume Next                                       'Fehlerbehandlung aus
TargetType = Target(1).Validation.Type          'Typ der Gültigkeitsregel merken
On Error GoTo 0              'Fehlerbehandlung wieder ein und Fehlercode löschen
If TargetType = xlValidateList Then    'prüfen, ob Typ 3 (nach Fehler ist Typ 0)
If Target.Cells(1).Validation.InCellDropdown Then
MsgBox "Dropdown"
End If
End If
End Sub

Ciao Matthias
Anzeige
AW: VBA: Abfrage, ob Gültigkeitsregel vorhanden
15.11.2005 13:53:42
Daniel
Hallo Matthias,
hast Du mal Selection.Validation.Formula1 versucht? wenn keine Gültigkeitregel vorhanden, gibt es einen abfangbaren Fehler
Daniel

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige