Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Columns(4)) Is Nothing Then
Cancel = True
UserForm1.Show
End If
Dim rngDV As Range
Dim wert_old As String
Dim wertnew As String
On Error GoTo Errorhandling
If Not Application.Intersect(Target, Range("D3:D150")) Is Nothing Then
Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)
If rngDV Is Nothing Then GoTo Errorhandling
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
Private Sub CommandButton1_Click()
Dim strTxt As String
Dim i As Integer
With ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then strTxt = strTxt & ", " & .List(i)
Next
End With
ActiveCell = Mid(strTxt, 3)
Unload Me
End Sub
Private Sub UserForm_Initialize()
With ListBox1
.List = Worksheets("Messmittel").Range("A1:A34").Value
.ListStyle = fmListStyleOption
.MultiSelect = fmMultiSelectMulti
End With
End Sub