Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA: Abfrage, ob Gültigkeitsregel vorhanden

Forumthread: 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
Anzeige

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
;
Anzeige
Anzeige

Infobox / Tutorial

Abfrage von Gültigkeitsregeln in Excel VBA


Schritt-für-Schritt-Anleitung

  1. Öffne den VBA-Editor: Drücke ALT + F11, um den Visual Basic for Applications (VBA) Editor in Excel zu öffnen.

  2. Füge den Code ein: Wähle das entsprechende Arbeitsblatt aus, in dem Du die Gültigkeitsregeln abfragen möchtest. Füge den folgenden Code in das Modul ein:

    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
               MsgBox "Dropdown!"
           End If
       End If
    ENDE:
       Application.EnableEvents = True
    End Sub
  3. Teste den Code: Wechsle zwischen Zellen und überprüfe, ob die MsgBox erscheint, wenn eine Gültigkeitsregel vorhanden ist.


Häufige Fehler und Lösungen

  • Laufzeitfehler 1004: Dieser Fehler kann auftreten, wenn Du versuchst, auf eine Zelle ohne Gültigkeitsregel zuzugreifen. Verwende die On Error Resume Next-Anweisung, um diese Fehler abzufangen.

    Beispiel:

    On Error Resume Next
    TargetType = Target(1).Validation.Type
    On Error GoTo 0
  • MsgBox erscheint nicht: Stelle sicher, dass die aktive Zelle wirklich eine Gültigkeitsregel hat. Überprüfe die Gültigkeitsregel mit ActiveCell.Validation.Type.


Alternative Methoden

Eine weitere Möglichkeit, die Gültigkeitsregel abzufragen, ist die Verwendung der Selection.Validation.Formula1-Eigenschaft. Diese Methode kann einen Fehler zurückgeben, wenn keine Gültigkeitsregel vorhanden ist, und ermöglicht so eine einfache Fehlerbehandlung.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
    If Not Target.Validation.Formula1 = vbNullString Then
        MsgBox "Gültigkeitsregel vorhanden!"
    End If
    On Error GoTo 0
End Sub

Praktische Beispiele

  1. Einfaches Dropdown: Wenn Du eine Zelle mit einer Dropdown-Liste hast, verwende die oben genannten Methoden, um zu prüfen, ob die Gültigkeitsregel aktiv ist.

  2. Mehrere Zellen prüfen: Du kannst die Logik anpassen, um mehrere Zellen gleichzeitig zu überprüfen, indem Du die Schleifenstruktur in VBA verwendest.


Tipps für Profis

  • Verwende Static Variablen: Um rekursive Aufrufe zu vermeiden, kannst Du Static Variablen verwenden, um den Status des aktuellen Codes zu speichern.

  • Optimierung: Achte darauf, die Application.EnableEvents-Eigenschaft richtig zu setzen, um unnötige Ereignisse zu vermeiden, die die Performance beeinträchtigen können.


FAQ: Häufige Fragen

1. Wie kann ich überprüfen, ob eine Gültigkeitsregel vorhanden ist, ohne Fehler zu generieren?
Verwende die On Error Resume Next-Anweisung, um Fehler abzufangen und stelle sicher, dass Du die Validation.Type-Eigenschaft korrekt abfragst.

2. Was ist der Unterschied zwischen xlCellTypeAllValidation und anderen Zelltypen?
xlCellTypeAllValidation umfasst alle Zellen mit einer definierten Gültigkeitsregel, während andere Zelltypen keine Gültigkeitsregel haben.

3. Wie kann ich die Art der Gültigkeitsregel abfragen?
Du kannst ActiveCell.Validation.Type verwenden, um die spezifische Art der Gültigkeitsregel abzufragen. Ein Wert von 3 bedeutet beispielsweise, dass es sich um eine Liste handelt.

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige