Convertir en lettres majuscules sans accents

Le 01/02/2012 à 16:07

Bonjour à tous,

Je suis confronté à un problème pour lequel j'ai déjà passé quasiment toute la journée, mais n'étant qu'un utilisateur lambda d'Excel, je n'en sors pas et espère que la communauté va pouvoir m'aider.

Je dois transformer certaines colonnes d'une feuille excel pour que les caractères sont convertis en lettres capitales SANS accents.

Voici que j'ai trouvé:

pour les lettres en majuscule, ceci fonctionne:

Sub ChangeCase()
    Dim Rng As Range
    On Error Resume Next
    Err.Clear
    Application.EnableEvents = False
    For Each Rng In Selection.SpecialCells(xlCellTypeConstants, _
             xlTextValues).Cells
        If Err.Number = 0 Then
            Rng.Value = StrConv(Rng.Text, vbUpperCase)
           ' Rng.Value = StrConv(Rng.Text, vbLowerCase)
           ' Rng.Value = StrConv(Rng.Text, vbProperCase)
        End If
    Next Rng
    Application.EnableEvents = True
End Sub

par contre, je n'arrive pas à remplacer les caractères spéciaux; j'ai trouvé ceci mais je n'arrive pas à le faire fonctionner; je colle ce code dans un module de vba, et quand je clique sur le petit "play", il me propose de donner un nom et de créer la macro, du coup il me rajoute du code plus bas, j'ai essayé de remplacer, d'intercaller, rien n'y fait... HEEELP:)

Function ConvertAccent(ByVal inputString As String) As String
' http://www.vbforums.com/archive/index.php/t-483965.html

Const AccChars As String = _
    "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
Const RegChars As String = _
    "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"

Dim i As Long, j As Long
Dim tempString As String
Dim currentCharacter As String
Dim found As Boolean
Dim foundPosition As Long

  tempString = inputString

  ' loop through the shorter string
  Select Case True
    Case Len(AccChars) <= Len(inputString)
      ' accent character list is shorter (or same)
      ' loop through accent character string
      For i = 1 To Len(AccChars)

        ' get next accent character
        currentCharacter = Mid$(AccChars, i, 1)

        ' replace with corresponding character in "regular" array
        If InStr(tempString, currentCharacter) > 0 Then
          tempString = Replace(tempString, currentCharacter, Mid$(RegChars, i, 1))
        End If

      Next i
    Case Len(AccChars) > Len(inputString)
      ' input string is shorter
      ' loop through input string
      For i = 1 To Len(inputString)

        ' grab current character from input string and
        ' determine if it is a special char
        currentCharacter = Mid$(inputString, i, 1)
        found = (InStr(AccChars, currentCharacter) > 0)

        If found Then

          ' find position of special character in special array
          foundPosition = InStr(AccChars, currentCharacter)

          ' replace with corresponding character in "regular" array
          tempString = Replace(tempString, currentCharacter, _
    Mid$(RegChars, foundPosition, 1))

        End If
      Next i
  End Select

  ConvertAccent = tempString
End Function

Je dois manquer des bases nécessaires pour utiliser ce code, en espérant qu'il soit efficace.

Pourriez-vous m'aider et me dire comment réaliser celà?

L'objectif: convertir des colonnes pour avoir les caractères en capitales sans accent.

Déjà merci pour avoir lu mon post

Cordialement,

David

Le 01/02/2012 à 17:01

j'espère que ça ne pose pas de problème que je m'auto réponde:)

En cherchant mieux sur le forum, j'ai trouvé un post qui traite du même problème que moi.

https://forum.excel-pratique.com/post121152.html?hilit=majuscule#p121152

quelqu'un qui demandait la même chose que moi s'est contenté du chercher/remplacer mais l'usage prévu pour mon fichier excel est d'exécuter la macro régulièrement et pour tout type de caractères.

La personne qui lui a répondu a posté un fichier excel contenant une macro qui fonctionne pour mettre en capitales sans accents.

super me direz-vous mais le problème c'est qu'ici c'est une fonction qu'on peut appliquer en recréant une nouvelle colonne, ce qui n'est pas mon but.

Voici le fichier excel contenant la fonction :

https://forum.excel-pratique.com/download/file.php?id=11155

Comment peut-on adapter ceci pour que celà s'applique en convertissant sur les mêmes cases plutôt que sur d'autres?

Pourrait-on aussi définir quelles colonnes seront concernées directement dans la macro?

le but ultime étant d'avoir un bouton dans la feuille excel sur lequel cliquer pour corriger automatiquement les minuscules et les mettre en majuscules sans accents.

Merci encore pour votre lecture

Le 01/02/2012 à 17:06

Bonjour

Ne connaissant pas exactement comment tu appelles la macro

Je considère que c'est via un bouton

Si ce n'est pas le cas il faudra adapter la macro

Sub ChangeCase()
Dim Rng As Range
Dim Plage As Range

  On Error Resume Next
  Set Plage = Cells.SpecialCells(xlCellTypeConstants, xlTextValues)
  On Error GoTo 0
  If Plage Is Nothing Then Exit Sub
  Application.EnableEvents = False
  For Each Rng In Plage
    Rng.Value = StrConv(ConvertAccent(Rng.Text), vbUpperCase)     'StrConv(Rng.Text, vbUpperCase)
  Next Rng
  Application.EnableEvents = True
End Sub

Function ConvertAccent(ByVal inputString As String) As String
' <!-- m --><a class="postlink" href="http://www.vbforums.com/archive/index.php/t-483965.html">http://www.vbforums.com/archive/index.php/t-483965.html</a><!-- m -->

Const AccChars As String = _
    "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
Const RegChars As String = _
    "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"

Dim i As Long, j As Long
Dim tempString As String
Dim currentCharacter As String
Dim found As Boolean
Dim foundPosition As Long

  tempString = inputString

  ' loop through the shorter string
 Select Case True
    Case Len(AccChars) <= Len(inputString)
      ' accent character list is shorter (or same)
     ' loop through accent character string
     For i = 1 To Len(AccChars)

        ' get next accent character
       currentCharacter = Mid$(AccChars, i, 1)

        ' replace with corresponding character in "regular" array
       If InStr(tempString, currentCharacter) > 0 Then
          tempString = Replace(tempString, currentCharacter, Mid$(RegChars, i, 1))
        End If

      Next i
    Case Len(AccChars) > Len(inputString)
      ' input string is shorter
     ' loop through input string
     For i = 1 To Len(inputString)

        ' grab current character from input string and
       ' determine if it is a special char
       currentCharacter = Mid$(inputString, i, 1)
        found = (InStr(AccChars, currentCharacter) > 0)

        If found Then

          ' find position of special character in special array
         foundPosition = InStr(AccChars, currentCharacter)

          ' replace with corresponding character in "regular" array
         tempString = Replace(tempString, currentCharacter, _
    Mid$(RegChars, foundPosition, 1))

        End If
      Next i
  End Select

  ConvertAccent = tempString
End Function

Le 01/02/2012 à 17:26

Fantastique! Un tout grand Merci!

j'ai assigné la macro à un bouton et ça fonctionne impec'

Je voudrais pouvoir prédéfinir quelles colonnes doivent avoir des maj sans accents; est-ce possible de spécifier celà dans le script?

Le 01/02/2012 à 17:52

Bonjour

Dans la macro principale

remplaces

Set Plage = Cells.SpecialCells(xlCellTypeConstants, xlTextValues)

par les colonnes voulues

Exemple: (pour les colonnes A à C )

Set Plage = Columns("A:C").SpecialCells(xlCellTypeConstants, xlTextValues)

Le 01/02/2012 à 18:02

Merci beaucoup!

J'ai tout à apprendre j'avoue... plutôt que de prendre une tranche de colonnes, est-il possible de ne prendre que "plic-ploc", certaines d'entres-elles? j'ai essayé en mettant ("N;P;X") ça ne marche pas, il veut des :

en fait, avant de convertir en majuscules, je dois réorganiser quelques colonnes, j'ai pu faire le macro facilement en enregistrant et voici le code qui en sort:

Sub reorg()

    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    Columns("A:A").Select
    Selection.Cut
    ActiveWindow.ScrollColumn = 2
    Columns("X:X").Select
    ActiveSheet.Paste
End Sub

Ca fonctionne parfaitement si je fais un bouton qui actionne celle-ci puis la macro que vous m'avez envoyée plus haut.

Je voudrais évidemment pouvoir tout faire en un click.

J'ai essayé en rajoutant votre code après ma petite macro dans le module de VBA mais quand j'essaye d'assigner une macro à un bouton, il ne me permet pas de tout prendre en une fois.

Est-il aussi possible de limiter l'utilisation du bouton qui active la macro à une seule fois? pour éviter que par erreur on puisse cliquer deux fois et tout désorganiser

Le 01/02/2012 à 18:21

Bonjour

Si tu ne veux pas que la macro "reorg" se fasse plus d'une fois, il te faut une marque qui te dise "Non"

Avant d'exécuter cette macro, il faut vérifier la marque et agir selon

Après la macro "Reorg" la colonne A est vide donc on peut tester si cette colonne est vide

edit : Je considère qu'au départ la colonne A contient des données

Exemple (sans véritable test)

Modifies ta macro principale

Sub ChangeCase()
Dim Rng As Range
Dim Plage As Range

  If Application.CountBlank(Columns(1)) <> Rows.Count Then
    ' Pas faite
    Rows(1).Delete
    Columns("B:B").Delete
    Columns("A:A").Cut Destination:=Columns("X")
  End If

  On Error Resume Next
  Set Plage = Cells.SpecialCells(xlCellTypeConstants, xlTextValues)
  On Error GoTo 0
  If Plage Is Nothing Then Exit Sub
  Application.EnableEvents = False
  For Each Rng In Plage
    Rng.Value = StrConv(ConvertAccent(Rng.Text), vbUpperCase)     'StrConv(Rng.Text, vbUpperCase)
 Next Rng
  Application.EnableEvents = True
End Sub

Pour choisir les colonnes "plic-ploc" utilises

Set Plage =  Range("A:A,C:C,H:H").SpecialCells(xlCellTypeConstants, xlTextValues)

Le 01/02/2012 à 18:54

SUPER MEGA GENIAL!

un tout grand MERCI !

Par contre j'avoue ne pas avoir compris l'astuce pour empêcher d'exécuter la macro plusieurs fois

En prime, et comme ça je suis vraiment comblé, je dois aussi convertir une colonne contenant date et heure

pour l'instant, tout est au format: dd.mm.yyyy hh:mm:ss

je dois arriver à ça: dd/mm/yyyy hh:mm:ss

avec les fonctions de base, je n'arrive pas à cause de l'heure hh:mm:ss qui apparemment perturbe l'opération

encore un petit coup de pouce?

Le 01/02/2012 à 20:56

ok, j'ai simplement fait une macro 'search & replace' en remplacant les . par des /

ça marche!

par contre, la blague... ça m'arrondit en enlevant les secondes et ça enlève les 0 pour une date comme 01.02.2012 20:48:15 ça devient 1/02/2012 20:48

c'est visiblement la correction automatique de excel - comment empêcher celà dans le script sans modifier les préférences générales d'Excel? Le but étant que le script soit utilisable sur un autre pc.

merci d'avance

Le 01/02/2012 à 21:02

Bonsoir

Vérifies le format de cellule

Tu dois avoir les secondes

style jj/mm/aaa hh:mm:ss

Le 01/02/2012 à 21:29

bonsoir et merci!

oui, en mettant un format de cellule personnalisé jj/mm/aaaa hh:mm:ss c'est déjà mieux mais quand même; TRES BIZZARE

première date: ok

deuxième date: 01.02.2012 10:25:31

devient 02/01/2012 10:25:31

il a inversé jour et mois!

je dois absolument régler ça, si les mois et jours s'inversent dès que le jour est inférieur à 13, ça pose un gros problème :s

J'ai trouvé ça pour changer le format des cellules sélectionnées:

Selection.NumberFormat = "dd/mm/yyyy hh:mm:ss"

ça marche

mais j'ai toujours le problème de l'inversion jours et mois si jours est plus petit ou égal à 12

Le 01/02/2012 à 22:03

Bonsoir

J'avais déjà posé cette question et pas de réponse

Peut-être en passant par la valeur avant de modifier le format de cellule

Peut-être en décomposant la date

Suis parti de 01.12.2012 20:45:18 dans une cellule

Avec ce code

Range("E" & ActiveCell.Row) = CDate(Mid(ActiveCell, 7, 4) & "/" & Mid(ActiveCell, 4, 2) & "/" & Left(ActiveCell, 2) & Mid(ActiveCell, 11))

J'obtiens le bon résultat 01/12/2012 20:45:18

peut-être cette solution (trouvée sur le net)

Salut tu sélectionnes la colonne, tu fais Données=> Convertir=>Suivant=> Suivant puis format J/M/A et là ça devrait marcher!

Il faut voir ton fichier

Je n'ai pas de solution standard

Le 01/02/2012 à 22:51

merci,

je ne comprends pas trop ce que je dois faire ou comment adapter le code que tu as collé ci-dessus.

Voici le code que j'ai pour l'instant:

Sub ChangeCase()
Dim Rng As Range
Dim Plage As Range

If Application.CountBlank(Columns(1)) <> Rows.Count Then
    Rows(1).Delete
    Columns("B:B").Delete
    Columns("A:A").Cut Destination:=Columns("X")
    Columns("A:A").Delete
    Columns("W:W").NumberFormat = "dd/mm/yyyy hh:mm:ss"
        Columns("W:W").Select
    Application.ReplaceFormat.NumberFormat = "dd/mm/yyyy hh:mm:ss"
    Selection.Replace What:=".", Replacement:="/", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=True

  End If

  On Error Resume Next
  Set Plage = Range("A:A,B:B,D:D,M:M,O:O").SpecialCells(xlCellTypeConstants, xlTextValues)
  On Error GoTo 0
  If Plage Is Nothing Then Exit Sub
  Application.EnableEvents = False
  For Each Rng In Plage
    Rng.Value = StrConv(ConvertAccent(Rng.Text), vbUpperCase)     'StrConv(Rng.Text, vbUpperCase)
 Next Rng
  Application.EnableEvents = True
End Sub

Function ConvertAccent(ByVal inputString As String) As String
' <!-- m --><a class="postlink" href="http://www.vbforums.com/archive/index.php/t-483965.html">http://www.vbforums.com/archive/index.php/t-483965.html</a><!-- m -->

Const AccChars As String = _
    "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
Const RegChars As String = _
    "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"

Dim i As Long, j As Long
Dim tempString As String
Dim currentCharacter As String
Dim found As Boolean
Dim foundPosition As Long

  tempString = inputString

  ' loop through the shorter string
Select Case True
    Case Len(AccChars) <= Len(inputString)
      ' accent character list is shorter (or same)
    ' loop through accent character string
    For i = 1 To Len(AccChars)

        ' get next accent character
      currentCharacter = Mid$(AccChars, i, 1)

        ' replace with corresponding character in "regular" array
      If InStr(tempString, currentCharacter) > 0 Then
          tempString = Replace(tempString, currentCharacter, Mid$(RegChars, i, 1))
        End If

      Next i
    Case Len(AccChars) > Len(inputString)
      ' input string is shorter
    ' loop through input string
    For i = 1 To Len(inputString)

        ' grab current character from input string and
      ' determine if it is a special char
      currentCharacter = Mid$(inputString, i, 1)
        found = (InStr(AccChars, currentCharacter) > 0)

        If found Then

          ' find position of special character in special array
        foundPosition = InStr(AccChars, currentCharacter)

          ' replace with corresponding character in "regular" array
        tempString = Replace(tempString, currentCharacter, _
    Mid$(RegChars, foundPosition, 1))

        End If
      Next i
  End Select

  ConvertAccent = tempString
End Function

je ne comprends pas parce que si je fais l'opération de d'abord définir le format de cellules puis de chercher et remplacer, ça fonctionne sans prob; ça arrive dès que j'exécute tout en même temps via la macro :s

Le 01/02/2012 à 23:25

Bonsoir

Comme ça, moi je ne sais pas

Avec ton fichier anonymisé peut-être il y a une solution

Mais je vois que tu as modifié la macro "Reorg" donc la condition testée (à savoir si la colonne A est vide) n'est peut-être (surement) plus valable et si tu relances la macro tu vas avoir des dysfonctionnements

Avec ton fichier

Le 02/02/2012 à 09:29

bonjour Banzai,

merci encore pour ton aide!

je vais anonymiser le fichier et le poster ici dans quelques minutes

la condition n'est-elle pas: s'il y a des cellules vides dans la colonne A? (elle ne sera jamais complètement vide mais il y a des milliers de row vides en dessous donc ça n'irait pas toujours?)

et voici le fichier

42fiche-identite-export.zip (11.19 Ko)

j'espère que tu y verras plus clair que moi:)

encore merci

Le 02/02/2012 à 11:13

Bonjour

Un essai fonctionnel sur le fichier fourni

72daikini-conversion-v001.zip (16.93 Ko)

Le 02/02/2012 à 11:21

FANTASTIQUE!!!!

un tout tout grand merci!

je reviens vers toi et marque le post comme résolu dès que j'ai eu le temps de vérifier celà plus en détail