Zwei Codes auf einem Modul-Tabellenblatt1?
24.02.2017 22:24:42
Peter
Die Codes habe ich in das Modul Tabelle1 eingefügt, wo auch beide Codes laufen sollen.
Problem: einzeln laufen die Codes einwandfrei. Beide laufen auch wenn ein Code im Modul "Tabelle1" und der andere in "Tabelle2" enthalten ist. Dies ist aber nicht Sinn der Sache, denn die beiden Codes sollen einfach auf Tabellenblatt 1 funktionieren.
Sobald die Codes in einem allgemeinen Modul oder im Modul "dieseArbeitsmappe" eingefügt werden laufen sie garnicht mehr.
Der eine Code erlaubt eine Mehrfachdropdownauswahl und der andere erlaubt "Formularzellen", bei denen der Text beim anklicken verschwindet.
Ich Danke Allen für ihre Mühe und Hilfe diesbezüglich.
Beide Codes zusammen:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address(0, 0) = "A7" And Target.Value = "TEST" Then
Application.EnableEvents = False
Target.Value = ""
Application.EnableEvents = True
Else
If [A7].Value = "" Then [A7].Value = "TEST"
End If
If Target.Address(0, 0) = "A14" And Target.Value = "TEST2" Then
Application.EnableEvents = False
Target.Value = ""
Application.EnableEvents = True
Else
If [A14].Value = "" Then [A14].Value = "TEST2"
End If
End Sub
---------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
'** Mehrfachauswahl über DropDown-Liste (Gültigkeitsprüfung)
'** Einfügen im Code-Container des betreffenden Arbeitsblattes
'** Dimensionierung der Variablen
Dim rngDV As Range
Dim wert_old As String
Dim wertnew As String
'** Errorhandling
On Error GoTo Errorhandling
'** Mehrfachauswahl im definierten Bereich (Bsp. A1:A100) durchführen
If Not Application.Intersect(Target, Range("A1:A100")) Is Nothing Then
'**Range definieren
Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)
If rngDV Is Nothing Then GoTo Errorhandling
'** Prüfen, ob eine gültige Zelle ausgewählt wurde und Werte eintragen
If Not Application.Intersect(Target, rngDV) Is Nothing Then
Application.EnableEvents = False
wertnew = Target.Value
Application.Undo
wertold = Target.Value
Target.Value = wertnew
If wertold "" Then
If wertnew "" Then
Target.Value = wertold & ", " & wertnew
End If
End If
End If
Application.EnableEvents = True
End If
Errorhandling:
Application.EnableEvents = True
End Sub