Formulaire de recherche - Ignorer les lettres accentuées

Tahititin · 13 Mai 2019

Bonjour le forum,

J'ai besoin d'un petit coup de main,
Je dispose d'un formulaire de recherche (UserForm1) permettent d’accéder à une base de données de plusieurs milliers de document et de pouvoir y accéder directement depuis le Userform en double-cliquant sur le lien.... bref
La recherche s'effectue par discipline (3 lettres majuscules) et par mot-clefs dans le titre du document. J'ai réussi à faire en sorte que la recherche par mot clef ignore les majuscule mais je ne parviens pas à faire en sorte qu'elle ignore les lettres accentuées.

Une idée pour m'aider ?

D'avance merci

VB:

Option Compare Text
Private Sub ComboBox1_Change()
Dim Cell As Range
Dim x As Long
Dim k As Integer
Discipline = ComboBox1
With ListView1
    .ListItems.Clear
       Me.TextBox1 = ""
    If Me.ComboBox1 = "" Then Exit Sub
    For Each Dis In Range("TabData[Disciplines]")
        If UCase(Dis) = UCase(ComboBox1) Then
            x = x + 1
            .ListItems.Add , , Dis.Offset(0, -1)
            For i = 1 To 9
                .ListItems(x).ListSubItems.Add , , Dis.Offset(0, i)
            Next i
            If Dis.Offset(0, 4) = "" Then
                For j = 1 To 9
                    .ListItems(x).ListSubItems(j).ForeColor = RGB(255, 0, 0)
                Next j
            End If
        End If
    Next Dis
End With
End Sub
Private Sub CommandButton1_Click()
ComboBox1 = "": TextBox1 = "": ComboBox1.SetFocus
End Sub
Private Sub CommandButton2_Click()
UserForm2.Show
End Sub
Private Sub TextBox1_AfterUpdate()
If Me.ComboBox1 = "" And Me.TextBox1 = "" Then Exit Sub
If Me.ComboBox1 <> "" Then
  If Me.TextBox1 = "" Then
    Call ComboBox1_Change
  Else
    RECHERCHE
  End If
Else
  Recherche2
End If

End Sub

Sub RECHERCHE()
Dim w As Worksheet, derlig&, cb$, i&, motclé As Boolean, s$, h As Object

With Me.ListView1
    For i = .ListItems.Count To 1 Step -1
        TitreDoc = .ListItems(i).ListSubItems(3).Text
        If Not (UCase(TitreDoc) Like "*" & UCase(TextBox1) & "*") Then
            .ListItems.Remove i
        End If
    Next i
End With
End Sub
Sub Recherche2()
motclé = Me.TextBox1
With ListView1
    .ListItems.Clear
     For Each Dis In Range("TabData[Disciplines]")
        If UCase(Dis.Offset(0, 3)) Like "*" & UCase(motclé) & "*" Then
            x = x + 1
            .ListItems.Add , , Dis.Offset(0, -1)
            For i = 1 To 9
                .ListItems(x).ListSubItems.Add , , Dis.Offset(0, i)
                Next i
            If Dis.Offset(0, 4) = "" Then
                For j = 1 To 9
                    .ListItems(x).ListSubItems(j).ForeColor = RGB(255, 0, 0)
                Next j
            End If
        End If
    Next Dis
End With
End Sub

Victor21 · 13 Mai 2019

Bonjour Tahititin.

Une petite recherche sur le forum vous aurait inévitablement mené ici

Tahititin · 13 Mai 2019

Merci Victor21
A quel endroit de mon code dois-je "appeler" cette fonction en sachant que la recherche par mot clefs s'effectue dans la listview1 et pas dans la feuille.

D'avance merci de ton retour

Tahititin · 15 Mai 2019

Bonjour,
Quelqu'un pour m'aider à intégrer la fonction ci-dessous dans le code en début de discussion ?

VB:

Function MajSansAccent(ByVal Chaine$)
Const VAccent = "àáâãäåéêëèìíîïðòóôõöùúûü", VSsAccent = "aaaaaaeeeeiiiioooooouuuu"
Dim Bcle&
For Bcle = 1 To Len(VAccent)
Chaine = Replace(Chaine, Mid(VAccent, Bcle, 1), Mid(VSsAccent, Bcle, 1))
Next Bcle
MajSansAccent = UCase(Chaine)
End Function

Après plusieurs test je tourne en rond. Je ne vois pas où intégrer la fonction et où "l'appeler" dans mes 2 fonctions de recherche.

D'avance merci de votre aide.

Formulaire de recherche - Ignorer les lettres accentuées

Tahititin

XLDnaute Occasionnel

Victor21

XLDnaute Barbatruc

Tahititin

XLDnaute Occasionnel

Tahititin

XLDnaute Occasionnel

Discussions similaires