in meinem Programm geht es um folgende Funktionalitäten:
In meiner persönlichen Arbeitsmappe habe ich eine Schaltfläche mit einem ihr zugewiesenen Makro (Formular aufrufen) eingefügt.
Bei Klick geht das Formular Suche auf. Im Formular gebe ich in der txtNachnamen.text den von mir gesuchten Kundennamen ein und durch Klick auf die unterhalb der Textbox stehende Schaltfläche suchen wird nach dem eingegebenen Namen gesucht. Durchsucht wird dabei die dem Programm zugrunde liegende Übersicht: workbooks(Verwaltung.xlsx).worksheets(Kunden), Spalte C.
Das bzw. die - falls mehrere Treffer - Ergebnisse werden anschließend in einer Listbox aufgelistet. Falls kein Kunde gefunden wird, soll es möglich sein, einen neuen Kunden als Datensatz in der Excel-Übersicht anzulegen. Dazu gibt es bereits eine andere Userform, die automatisch aufgeht, wenn man "neues Kundenprofil anlegen" mit OK bestätigt.
Alles klappt bisher einwandfrei.
Problem
Die erwähnte Listbox besteht aus vier Spalten. In der Listbox werden nicht alle dem Kunden zuordenbaren Merkmale (lt. der Excel-Übersicht sind es ja insgesamt 15), sondern lediglich 4 abgebildet.
Im weiteren Schritt soll es möglich sein, den gesuchten Datensatz aus der Listbox per Doppelklick in eine neue Userform (frmMKKundenVerwaltung), und dort in die entsprechenden Textboxen zu übertragen. Neben den vier Spalten in der Listbox (Nachname, Vorname, Straße/Hausnummer, PLZ/Ort) sind es in der Ziel-UserForm unter anderem das Geburtsdatum, Anschrift der Betriebsstätte, beizubringende Unterlagen etc.
Und dieser Datentransfern von der Listbox in die andere Userform funktioniert nicht.
Meine Prozeduren:
1. Suche Kunden und Eintrag in der Listbox
Private Sub cmdSucheListeFuellen_Click()
Suchen
End Sub
Private Sub Suchen()
Dim lng As Long
Dim i As Integer
Dim q As Integer
Application.ScreenUpdating = False
'liste füllen
'Zeilemax = ActiveSheet.UsedRange.Rows.Count
With frmMKSuche
.ListBox1.Clear
Workbooks("Verwaltung.xlsx").Worksheets("Kunden").Activate
i = 0
For lng = 3 To ActiveSheet.UsedRange.Rows.Count
If InStr(LCase(Cells(lng, 3).Value), LCase(.txtNachname.Value)) > 0 Then
.ListBox1.AddItem Cells(lng, 3).Value
.ListBox1.Column(1, i) = Cells(lng, 4).Value
.ListBox1.Column(2, i) = Cells(lng, 7).Value
.ListBox1.Column(3, i) = Cells(lng, 8).Value
.ListBox1.Column(4, i) = Cells(lng, 9).Value
i = i + 1
Exit Sub
Else
End If
Next lng
q = MsgBox("Das Kundenprofil konnte nicht gefunden werden." & vbCrLf & _
"Soll ein neuer Kunde angelegt werden", vbYesNo + vbQuestion)
If q = vbYes Then
frmMKKundenAnlegen.Show
Else
Exit Sub
End If
End With
Application.ScreenUpdating = True
End Sub
2. Doppelklick auf den Eintrag der ListboxDazu versuche ich zuerst über eine function, die Zeile herauszufinden, auf die sich der gesuchte Kundenname bezieht und diese Zeile in einer Long-Variablen zu speichern.
Anschließend startet die Prozedur ListBox1_DblClick, innerhalb derer die über die function gespeicherte Zeile verwendet wird.
Public Function ZeileGesucht() As Integer
Dim Zeile As Integer
'zugehörige Tabelle aktivieren
Workbooks("Verwaltung.xlsx").Worksheets("Kunden").Activate
'Zeile mit ausgewähltem Kunden suchen
Zeile = 3
Do While Cells(Zeile, 3).Value ""
If Cells(Zeile, 3).Value = frmMKSuche.txtNachname.Text Then
Exit Do
End If
Zeile = Zeile + 1
Loop
'gesuchte Zeile
ZeileGesucht = Zeile
End Function
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim Zeile As Integer
'zeile mit ausgewähltem Kunden suchen
Zeile = ZeileGesucht(Me)
'Daten des Kunden in neue UserForm übertragen
With frmMKKundenVerwaltung
.txtVorname3.Text = Cells(Zeile, 4).Value
.txtNachname3.Text = Cells(Zeile, 3).Value
.txtGeburtsdatum3.Text = Cells(Zeile, 5).Value
.txtStraße1.Text = Cells(Zeile, 7).Value
.txtPLZ1.Text = Cells(Zeile, 8).Value
.txtStraßeFirma2.Text = Cells(Zeile, 9).Value
.txtPLZFirma2.Text = Cells(Zeile, 10).Value
.Show
End With
End Sub
Die .xlsm ist angehängt.https://www.herber.de/bbs/user/106507.xlsm
Könnte mir jemand helfen?
Viele Grüße
Tomasz