|
Du haben:
Du brauchen für Drop - Down im Standard-Modul (Name der Sub aufgezeichnet)
Sub Dropdown4_BeiÄnderung()
Dim oDrop As Object
Dim oole As OLEObject
Dim rngFound As Range
Set oole = ActiveSheet.OLEObjects("Textbox1")
Set oDrop = ActiveSheet.Shapes(Application.Caller).OLEFormat.Object
'MsgBox oDrop.List(oDrop.ListIndex)
Set rngFound = Sheets("Freunde").Columns("A").Find(oDrop.List(oDrop.ListIndex), , xlValues)
'keine Rekursion
Application.EnableEvents = False
If Not rngFound Is Nothing Then oole.Object.Text = rngFound.Offset(, 1).Value
Application.EnableEvents = True
End Sub
und für das ActiveX im Klasse Tabelle1(Maske) - Modul
Private Sub TextBox1_Change()
Dim oDrop As Object
Dim strList As String, FA As String
Dim Rng As Range, c As Range
Set oDrop = ActiveSheet.Shapes("Drop Down 4").OLEFormat.Object
'MsgBox oDrop.List(oDrop.ListIndex)
strList = oDrop.List(oDrop.ListIndex)
With Sheets("Freunde")
Set Rng = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
With Rng
Set c = .Find(strList, , xlValues)
If Not c Is Nothing Then
FA = c.Address
Do
c.Offset(, 1).Value = TextBox1.Text
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FA
End If
End With
End With
End Sub
PS - wie immer Quick§Dirty - ohne Gewähr
|