Ah ces foutus accents !!!!

[micie1509]

Bonjour à tous,

J'ai une base de donnée avec un formulaire qui comprend toutes les lettres alphabétiques (ce n'est pas moi qui l'ai fait, je l'ai juste un peu modifié pour mes besoins). Lorsqu'à partir du formulaire, je clique sur les lettre, il m'affiche tous les items commençant par cette lettre. Tout fonctionne bien, sauf lorsque je clique sur la lettre "E" qui ne m'affiche que les items commençant par "E" et non ceux qui commencent par une lettre accentuée. Je comprends que ce ne sont pas les mêmes caractères, mais je me demandais si il y avait une façon sans enlever les accents de faire afficher ces items dont la première lettre comporte un accent. Si je n'ai vraiment pas le choix, j'enlèverai les accents mais j'aimerais mieux ne pas avoir à les enlever.

Merci beaucoup pour votre réponse !

Micie

 

[Docmarti]

Re : Ah ces foutus accents !!!!

Bonjour.

Voici une façon de faire :

Private Sub GrLettres_Click()
  F_Mat.Lettre = GrLettres.Caption
  F_Mat.choixnom.Clear
  If GrLettres.Caption = "Tous" Then
    For Each c In Range(Sheets("materiaux").[B3], Sheets("materiaux").[B65000].End(xlUp))
      F_Mat.choixnom.AddItem c
    Next c
  Else
   LettreEtAccents = GrLettres.Caption
   
  Select Case GrLettres.Caption
   Case "A"
    LettreEtAccents = LettreEtAccents & "ÀÁÂÃÄÅÆ"
   Case "E"
    LettreEtAccents = LettreEtAccents & "ÈÉÊË"
   Case "I"
    LettreEtAccents = LettreEtAccents & "ÌÍÎÏ"
   Case "O"
     LettreEtAccents = LettreEtAccents & "ÒÓÔÕÖ"
   Case "U"
     LettreEtAccents = LettreEtAccents & "ÙÚÛÜ"
   Case "Y"
    LettreEtAccents = LettreEtAccents & "Ý"
   Case "C"
     LettreEtAccents = LettreEtAccents & "Ç"
   Case "N"
     LettreEtAccents = LettreEtAccents & "Ñ"
  End Select
  
  LettreEtAccents = UCase(LettreEtAccents)
  
    For Each c In Range(Sheets("materiaux").[B3], Sheets("materiaux").[B65000].End(xlUp))
       
      'If Left(c.Value, 1) = GrLettres.Caption Then
      If InStr(LettreEtAccents, UCase(Left(c.Value, 1))) Then
       F_Mat.choixnom.AddItem c
      End If
    Next c
  End If
  If F_Mat.choixnom.ListCount > 0 Then
    F_Mat.choixnom.ListIndex = 0
  End If
End Sub

Docmarti

 

[micie1509]

Re : Ah ces foutus accents !!!!

Wow ! Merci beaucoup, je vais l'essayer.

 

[job75]

Re : Ah ces foutus accents !!!!

Bonjour micie1509, Docmarti,

Bah on peut toujours remplacer n'importe quelle lettre par n'importe quelle autre !!!!

Par exemple cette fonction personnalisée, à placer dans un module standard :

Function NOACCENT$(t$)
Dim a$, b$, i%
a = "àâçéèêëîïôùûüÿÀÂÇÉÈÊËÎÏÔÙÛÜŸ"
b = "aaceeeeiiouuuyAACEEEEIIOUUUY"
For i = 1 To Len(a)
  t = Replace(t, Mid(a, i, 1), Mid(b, i, 1))
Next
NOACCENT$ = t
End Function

Entrer par exemple en B2 =NOACCENT(A2)

A+

 

[job75]

Re : Ah ces foutus accents !!!!

Re,

Si l'on veut faire le remplacement sur une colonne entière :

Sub NoAccent()
Dim a$, b$, col%, i%
a = "àâçéèêëîïôùûüÿÀÂÇÉÈÊËÎÏÔÙÛÜŸ"
b = "aaceeeeiiouuuyAACEEEEIIOUUUY"
col = 2 'colonne B
'[A:A].Copy Columns(col) 'si nécessaire
For i = 1 To Len(a)
  Columns(col).Replace Mid(a, i, 1), Mid(b, i, 1), xlPart
Next
End Sub

A+

 

[Docmarti]

Re : Ah ces foutus accents !!!!

Bonjour job75.

Le but de micie1509 n'est pas de remplacer les lettres accentuées mais de les trouver.
Par exemple s'il cherchee "E" il veut trouver aussi "ÈÉÊË".

A+

 

[micie1509]

Re : Ah ces foutus accents !!!!

Bonjour Docmarti,

Yahoo ! Ça fonctionne super bien. Un gros merci !

 

[micie1509]

Re : Ah ces foutus accents !!!!

Bonjour Job75,

Merci pour ta réponse. Je l'aurais utilisé si je n'aurais pas eu le choix de remplacer les lettres accentuées, mais la solution de Docmarti fonctionne vraiment super bien. Merci encore d'avoir pris le temps.

 

[job75]

Re : Ah ces foutus accents !!!!

Re,

Je voulais juste montrer la fonction NOACCENT.

Dans le fichier du post #1, code du module de classe :

Public WithEvents GrLettres As MSForms.CommandButton

Private Sub GrLettres_Click()
F_Mat.Lettre = GrLettres.Caption
F_Mat.choixnom.Clear
For Each c In Range(Sheets("materiaux").[B3], Sheets("materiaux").[B65000].End(xlUp))
  If NOACCENT(Left(c, 1)) Like IIf(GrLettres.Caption = "Tous", "*", GrLettres.Caption) _
    Then F_Mat.choixnom.AddItem c
Next
If F_Mat.choixnom.ListCount > 0 Then F_Mat.choixnom.ListIndex = 0
End Sub

Function NOACCENT$(t$)
Dim a$, b$, i%
a = "àâçéèêëîïôùûüÿÀÂÇÉÈÊËÎÏÔÙÛÜŸ"
b = "aaceeeeiiouuuyAACEEEEIIOUUUY"
For i = 1 To Len(a)
  t = Replace(t, Mid(a, i, 1), Mid(b, i, 1))
Next
NOACCENT$ = t
End Function

A+

 

[micie1509]

Re : Ah ces foutus accents !!!!

Wow, ça fonctionne aussi. J'étais sous l'impression (à cause du terme "Replace" et "NOACCENT") que les lettres accentuées étaient changées par des lettres sans accent. Mais non, ça fonctionne super bien. Merci beaucoup job75 ! Et merci à toute l'équipe de excel-downloads.com vous êtes vraiment forts.

 

[Docmarti]

Re : Ah ces foutus accents !!!!

Et comme la programmation consiste à tout prévoir, une vérification supplémentaire s'impose pour s'assurer de n'avoir pas oublié un accent.

Private Sub GrLettres_Click()
  F_Mat.Lettre = GrLettres.Caption
  F_Mat.choixnom.Clear
  If GrLettres.Caption = "Tous" Then
    For Each c In Range(Sheets("materiaux").[B3], Sheets("materiaux").[B65000].End(xlUp))
      F_Mat.choixnom.AddItem c
    Next c
  Else
   
   LettreEtAccents = GrLettres.Caption
  Select Case GrLettres.Caption
   Case "A"
    LettreEtAccents = LettreEtAccents & "ÀÁÂÃÄÅÆ"
   Case "E"
    LettreEtAccents = LettreEtAccents & "ÈÉË" '"ÈÉÊË"
   Case "I"
    LettreEtAccents = LettreEtAccents & "ÌÍÎÏ"
   Case "O"
     LettreEtAccents = LettreEtAccents & "ÒÓÔÕÖ"
   Case "U"
     LettreEtAccents = LettreEtAccents & "ÙÚÛÜ"
   Case "Y"
    LettreEtAccents = LettreEtAccents & "Ý"
   Case "C"
     LettreEtAccents = LettreEtAccents & "Ç"
   Case "N"
     LettreEtAccents = LettreEtAccents & "Ñ"
  End Select
  
  LettreEtAccents = UCase(LettreEtAccents)
  TousLesCaracteres = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" & "ÀÁÂÃÄÅÆ" & "ÈÉË" & "ÌÎÍÏ" & "ÒÓÔÕÖ" & "ÙÚÛÜ" & "Ý" & "Ç" & "Ñ"

    For Each c In Range(Sheets("materiaux").[B3], Sheets("materiaux").[B65000].End(xlUp))
       
      If InStr(UCase(LettreEtAccents), UCase(Left(c.Value, 1))) Then
       F_Mat.choixnom.AddItem c
      End If
      
      If PasTrouver = False Then
       If InStr(UCase(TousLesCaracteres), UCase(Left(c.Value, 1))) = 0 Then
        MsgBox "Ligne " & c.Row & vbCrLf & c.Value & vbCrLf & "ne sera pas trouvé", , "Caractère oublié"
        PasTrouver = True
       End If
      End If
      
    Next c
  End If
  If F_Mat.choixnom.ListCount > 0 Then
    F_Mat.choixnom.ListIndex = 0
  End If
End Sub

Docmarti

 

[micie1509]

Re : Ah ces foutus accents !!!!

Merci beaucoup !