Datenüberprüfung - Gültigkeitskriterium - Quelle
11.05.2019 20:50:14
Anton
ich stehe vor folgendem Problem und hoffe ihr könnt mir helfen:
Im Tabellenblatt "anro" kann man in der zweiten Zeile per Dropdown Menü Daten vom Tabellenblatt "Stammdaten" auswählen. Dies geschieht über die Listenzuordnung "=Land". Ich möchte nun durch aktivieren der Checkbox links neben dieser Legende die Listenzuordnung der Zellen in der zweiten Zeile (B2:Y2) löschen. Bei deaktivierter Checkbox soll die Listenzuordnung "=Land" wiederhergestellt werden, sodass der zugehörige Code welcher nach Zellen mit dieser Listenzuordnung sucht wieder funktioniert.
In meiner Variante versuche ich dies wie folgt zu machen:
Range("B2:Y2").Validation.Formula1 = ""
bzw.
Range("B2:Y2").Validation.Formula1 = "=Land"
Dies funktioniert aber nicht. Anbei sende ich den Code aus dem Tabellenblatt sowie den aktuellen Arbeitsstand.
Ich würde mich sehr freuen wenn Ihr mir mal wieder aus der Patsche helft :)
Arbeitsstand:
https://www.herber.de/bbs/user/129717.xlsm
Code aus Tabellenblatt:
Option Explicit
Sub SimulationCheckBox()
With ActiveSheet.Shapes(Application.Caller).OLEFormat.Object
.Font.Name = "Wingdings"
.Font.Size = 40
If .Text = Chr(254) Then 'deaktiviert
.Text = Chr(168)
Range("B2:Y2").Validation.Formula1 = ""
Range("B2:Y2").SpecialCells(xlCellTypeConstants).Select
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ThemeColor = 7
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ThemeColor = 7
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 7
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ThemeColor = 7
.TintAndShade = 0
.Weight = xlThick
End With
Else 'aktiviert
.Text = Chr(254)
Range("B2:Y2").Validation.Formula1 = "=Land"
Range("B2:Y2").Select
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDash
.ThemeColor = 6
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDash
.ThemeColor = 6
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDash
.ThemeColor = 6
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDash
.ThemeColor = 6
.TintAndShade = 0
.Weight = xlMedium
End With
End If
End With
End Sub