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.052 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. |
sevISDN 1.0 Überwachung aller eingehender Anrufe! Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 sevGraph (VB/VBA) Grafische Auswertungen Präsentieren Sie Ihre Daten mit wenig Aufwand in grafischer Form. sevGraph unterstützt hierbei Balken-, Linien- und Stapel-Diagramme (Stacked Bars), sowie 2D- und 3D-Tortendiagramme und arbeitet vollständig datenbankunabhängig! |
||||||||||||||||
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. |