AW: Frage zu Listbox und UserForm
10.07.2004 22:18:48
maine-coon
Ich packe die ganzen Codes mal dahinter. Leider habe ich das meiste davon nicht selber geschrieben.
Private Sub ComboBox1_Change()
Kundennummern
End Sub
Private Sub ComboBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Set meineliste = Application.Names("KundeOrt").RefersToRange
If KeyCode = 13 Then
If Not meineliste.Find(ComboBox1.Value, , xlValues, xlWhole) Is Nothing Then
ActiveCell = ComboBox1.Value
Else
MsgBox "Nicht vorhandener Wert"
End If
UserForm1.Hide
End If
End Sub
------------------------------------------------------------
Private Sub UserForm_Activate()
userform_fensterposition_setzen 1
If ActiveCell <> "" Then UserForm1.ComboBox1.Value = ActiveCell
ComboBox1.SelStart = 0
ComboBox1.SelLength = 256
End Sub
-----------------------------------------------
Private Sub Kundennummern()
Dim temp_aktiveKundenzelle As Range
Set KundeOrtRange = Application.Names("KundeOrt").RefersToRange
Set temp_aktiveKundenzelle = KundeOrtRange.Find(ComboBox1.Value, , xlValues, xlWhole)
If Not temp_aktiveKundenzelle Is Nothing Then
ActiveCell = ComboBox1.Value
Set aktiveKundennummer = temp_aktiveKundenzelle.Offset(0, 1)
'REM wenn Combobox leer, folgt Fehler
If Not aktiveKundennummer Is Nothing Then ActiveCell.Offset(0, -1) = aktiveKundennummer.Value
Else
MsgBox "Nicht vorhandener Wert"
End If
End Sub
Private Sub UserForm_Terminate()
Set meineliste = Application.Names("KundeOrt").RefersToRange
If Not meineliste.Find(ComboBox1.Value, , xlValues, xlWhole) Is Nothing Then
ActiveCell = ComboBox1.Value
Kundennummern
End If
UserForm1.Hide
End Sub
-------------------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim temp As Range
Set temp = Intersect(Range("Kunde"), Target)
If Not temp Is Nothing Then
Cancel = True
UserForm1.Show
Exit Sub
End If
Set temp = Intersect(Range("Bericht"), Target)
If Not temp Is Nothing Then
Cancel = True
UserForm2.Show
End If
End Sub
-----------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim temp As Range
Set temp = Intersect(Range("Kunde"), Target)
If Not temp Is Nothing Then
Cancel = True
UserForm1.Show
Exit Sub
End If
Set temp = Intersect(Range("Bericht"), Target)
If Not temp Is Nothing Then
Cancel = True
UserForm2.Show
End If
End Sub
----------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo wsh_sch_err
Dim zeile%, spalte%
zeile = ActiveCell.Row
spalte = ActiveCell.Column
Rem Abfrage, ob der Bereich Kunde aktiviert ist
Set gueltigkeitsrange = Range("Kunde")
If Intersect(Target, gueltigkeitsrange) Is Nothing Then GoTo Tätigkeit
tarvalue = Target.Value
'REM es macht keinen Sinn
'die Userform für mehr als
'EINE Zelle gleichzeitig zu öffnen!
'es kann sogar zum Absturz führen!
If Target.Cells.Count = 1 And Worksheets("Kunden").CheckBox1 Then
UserForm1.Show
End If
'REM notwendig, um inkonsistente Daten in Spalte K und L zu vermeiden!
Private Sub pruefe_bereich(col As Range, r As Range, ku As String)
On Error GoTo pruefe_err
Set KundeOrtRange = Application.Names("KundeOrt").RefersToRange
Set k = Application.Names(ku).RefersToRange
For Each a In r.Areas
For Each c In a.Cells
If k.Find(c.Value, , xlValues, xlWhole) Is Nothing Then
Intersect(col, c.EntireRow).ClearContents
Else
Set temp_aktiveKundenzelle = KundeOrtRange.Find(c.Value, , xlValues, xlWhole)
If temp_aktiveKundenzelle Is Nothing Then
Intersect(col, c.EntireRow).ClearContents
c.ClearContents
Else
Intersect(col, c.EntireRow) = temp_aktiveKundenzelle.Offset(0, 1)
End If
End If
Next c, a
pruefe_err:
End Sub
------------------------------------
Das sollten die wichtigsten Teile sein.
es ist so. Kannste mir glauben. Sobald ich die Userform öffne und einen Wert aus der Liste anklicke, wird dieser bereits in der aktiven Zelle eingetragen.
Hast Du noch eine andere Idee, wie ich das hinbekomme?
Gruß Achim