Heute möchten wir Ihnen ein paar Prozeduren vorstellen, mit denen neue Einträge nur dann hinzugefügt werden, wenn diese noch nicht in der ListBox bzw. ComboBox vorhanden sind. Hierbei lässt sich auf Wunsch auch zwischen Groß-/Kleinschreibung unterscheiden. Option Explicit ' benötigte API-Deklarationen Private Declare Function SendMessage Lib "user32" _ Alias "SendMessageA" ( _ ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Integer, _ ByVal lParam As Any) As Long Code für die ListBox: ' Nur hinzufügen, wenn noch nicht vorhanden, unter ' Berücksichtigung exakter Groß-/Kleinschreibung Private Sub LBAddIfNewExakt(LB As ListBox, strText As String) Const LB_FINDSTRING_EXAKT As Long = &H1A2 Dim FundIndex As Long Dim StartIndex As Integer Dim LBListCount As Long StartIndex = -1 LBListCount = LB.ListCount FundIndex = SendMessage(LB.hwnd, LB_FINDSTRING_EXAKT, _ StartIndex, ByVal strText) Do If FundIndex = -1& Then ' nicht gefunden -> Abbruch Suche LB.AddItem strText Exit Do Else If LB.List(FundIndex) = strText Then Exit Do ' schon exakt vorhanden Else ' gefunden aber nicht exakt gleich If FundIndex + 1 < LBListCount Then ' -> weitersuchen StartIndex = FundIndex + 1 Else ' Listenende wurde erreicht -> Abbruch Suche LB.AddItem strText Exit Do End If End If End If FundIndex = SendMessage(LB.hwnd, LB_FINDSTRING_EXAKT, _ StartIndex, ByVal strText) Loop End Sub ' Groß- / Kleinschreibung ist egal Private Sub LBAddIfNewTolerant(LB As ListBox, strText As String) Const LB_FINDSTRING_EXAKT As Long = &H1A2 If SendMessage(LB.hwnd, LB_FINDSTRING_EXAKT, -1, _ ByVal strText) = -1& Then LB.AddItem strText End If End Sub Code für die ComboBox: ' Nur hinzufügen, wenn noch nicht vorhanden, unter ' Berücksichtigung exakter Groß-/Kleinschreibung Private Sub CBAddIfNewExakt(CB As ComboBox, strText As String) Const CB_FINDSTRING_EXAKT As Long = &H158 Dim FundIndex As Long Dim StartIndex As Integer Dim CBListCount As Long StartIndex = -1 CBListCount = CB.ListCount FundIndex = SendMessage(CB.hwnd, CB_FINDSTRING_EXAKT, _ StartIndex, ByVal strText) Do If FundIndex = -1& Then ' nicht gefunden -> Abbruch Suche CB.AddItem strText Exit Do Else If CB.List(FundIndex) = strText Then Exit Do ' schon exakt vorhanden Else ' gefunden aber nicht exakt gleich If FundIndex + 1 < CBListCount Then ' -> weitersuchen StartIndex = FundIndex + 1 Else ' Listenende wurde erreicht -> Abbruch Suche CB.AddItem strText Exit Do End If End If End If FundIndex = SendMessage(CB.hwnd, CB_FINDSTRING_EXAKT, _ StartIndex, ByVal strText) Loop End Sub ' Groß- / Kleinschreibung ist egal Private Sub CBAddIfNewTolerant(CB As ComboBox, strText As String) Const CB_FINDSTRING_EXAKT As Long = &H158 If SendMessage(CB.hwnd, CB_FINDSTRING_EXAKT, -1, _ ByVal strText) = -1& Then CB.AddItem strText End If End Sub Beispiel: Private Sub Form_Load() ' ein paar Testeinträge Dim BeispielText(6) As String BeispielText(0) = "Herbert" BeispielText(1) = "Müller" BeispielText(2) = "Meyer" BeispielText(3) = "MEYER" BeispielText(4) = "Grever" BeispielText(5) = "Ofen" BeispielText(6) = "Ofen" Dim i As Integer ' ListBox/ComboBox mit allen Einträgen füllen, wobei ' bereits vorhandene Einträge nicht doppelt ' eingefügt werden. Hierbei soll die ' Groß-/Kleinschreibung UNBERÜCKSICHTIGT bleiben! List1.Clear For i = 0 To 6 LBAddIfNewExakt List1, BeispielText(i) Next i Combo1.Clear For i = 0 To 6 CBAddIfNewExakt Combo1, BeispielText(i) Next i ' jetzt alle nicht doppelten alle Einträge ' hinzufügen, wobe die Groß-/Kleinschreibung ' berücksichtigt werden soll List2.Clear For i = 0 To 6 LBAddIfNewTolerant List2, BeispielText(i) Next i Combo2.Clear For i = 0 To 6 CBAddIfNewTolerant Combo2, BeispielText(i) Next i End Sub Dieser Tipp wurde bereits 16.082 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats Mai 2024 Hermann Röttger Wochentage eines Datumsbereichs ermitteln Wochentage eines Datumsbereichs ermitteln, optional mit Feiertagsberechnung sevZIP40 Pro DLL Zippen und Unzippen wie die Profis! Mit nur wenigen Zeilen Code statten Sie Ihre Anwendungen ab sofort mit schnellen Zip- und Unzip-Funktionen aus. Hierbei lassen sich entweder einzelnen Dateien oder auch gesamte Ordner zippen bzw. entpacken. |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |