Discussion :

[jeromegagne]

Bonjour à tous,

je suis à la recherche d'un code en vba afin d’améliorer une macro que j'ai mise en place.
J'ai pour mission de retravailler des tables de base de données. Dans un premier temps j'ai crée un macro pour passer tous les caractères en majuscule de cette façon :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub ConvertingUcase()
Dim TheString As String, TheLetter As String, TheUcase As String
Dim i As Byte
    Application.EnableEvents = False
    For Each c In Selection
        TheString = c.Value
        For i = 1 To Len(TheString)
            TheLetter = Mid(TheString, i, 1)
            Select Case TheLetter
            Case Chr(224), Chr(225), Chr(226), Chr(227), Chr(228), Chr(229) 'Les "A"
                TheLetter = Chr(65)
                TheUcase = TheUcase & TheLetter
            Case Chr(232), Chr(233), Chr(234), Chr(235) ' les "E"
                TheLetter = Chr(69)
                TheUcase = TheUcase & TheLetter
            Case Chr(236), Chr(238), Chr(238), Chr(239) 'Les "I"
                TheLetter = Chr(73)
                TheUcase = TheUcase & TheLetter
            Case Chr(243), Chr(243), Chr(244), Chr(245), Chr(246) 'Les "O"
                TheLetter = Chr(79)
                TheUcase = TheUcase & TheLetter
            Case Chr(249), Chr(250), Chr(251), Chr(252) 'Les "U"
                TheLetter = Chr(85)
                TheUcase = TheUcase & TheLetter
            Case Else
            TheLetter = UCase(TheLetter)
            TheUcase = TheUcase & TheLetter
            End Select
        Next
        c.Value = TheUcase
        TheUcase = ""
    Next
    Application.EnableEvents = True
End Sub

cette macron fonctionne tres bien, mais, cela modifie aussi les fonction VRAI / FAUX, cette valeur est considérée comme un texte et passe en alignement a gauche (c'est le seul moyen de repérer que la valeur n'est plus considérée comme VRAI/FAUX lors de la réimportation de ces tables dans la base de données...) si je double clic sur la cellule et que je change de cellule, la valeur repasse en alignement centré et est considérée comme valeur VRAI / FAUX...
je ne sais pas si j'ai été clair :-/

Auriez vous une idée de ce que je pourrais ajouter comme code afin que ma macro je puisse ne pas modifier les valeur VRAI/FAUX de mes tables ?

[QuestVba]

Bonjour,

tu pourrais faire un test pour voir si ta cellule contient une formule. Une aide: http://www.developpez.net/forums/d93...tient-formule/

[jeromegagne]

bonjour, merci pour votre réponse, mais j'ai essayé ce code seul dans un premier temps, cela met bien en rouge lorsqu'il y a une formule par contre, cela ne détecte pas pour un VRAI / FAUX...

[Didier Ch.]

Bonjour
Il ne faut pas faire le remplacement pur toutes les valeurs numérique s(dont VRAI et FAUX).
Donc je propose de commencer par tester If Not IsNumeric(c.Value) Then avant de faire les différentes conversions.
Car TheString = c.Value convertit la valeur en String, donc après forcément, c.Value = TheUcase convertiti ta cellule en texte.

Il sufit donc d'ajouter le code en rouge :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
    For Each c In Selection
        If Not IsNumeric(c.Value) Then
            TheString = c.Value
            For i = 1 To Len(TheString)
                TheLetter = Mid(TheString, i, 1)
                Select Case TheLetter
                   Case Chr(224), Chr(225), Chr(226), Chr(227), Chr(228), Chr(229) 'Les "A"
                      TheLetter = Chr(65)
                      TheUcase = TheUcase & TheLetter
                   Case Chr(232), Chr(233), Chr(234), Chr(235) ' les "E"
                      TheLetter = Chr(69)
                      TheUcase = TheUcase & TheLetter
                   Case Chr(236), Chr(238), Chr(238), Chr(239) 'Les "I"
                      TheLetter = Chr(73)
                      TheUcase = TheUcase & TheLetter
                   Case Chr(243), Chr(243), Chr(244), Chr(245), Chr(246) 'Les "O"
                      TheLetter = Chr(79)
                      TheUcase = TheUcase & TheLetter
                   Case Chr(249), Chr(250), Chr(251), Chr(252) 'Les "U"
                      TheLetter = Chr(85)
                      TheUcase = TheUcase & TheLetter
                   Case Else
                      TheLetter = UCase(TheLetter)
                      TheUcase = TheUcase & TheLetter
                End Select
            Next i
            c.Value = TheUcase
            TheUcase = ""
        End If
    Next c

J'ai testé, ça marche sur mon exemple.
Et pour toi ?

Cdlt,
Didier

[jeromegagne]

Bonjour Didier,
merci pour cette explication. J'ai appliqué ta méthode et cela fonctionne !!

[Didier Ch.]

Alors un petit aiderait à la lecture du forum...
(et pourquoi pas un petit au passage...)

[vinc_bilb]

Bonjour,

Même si c'est résolu, je fais la suggestion suivante, en passant par le specialCells pour déjà ne retenir que ce qui est valeur constante (donc pas les formules)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Conv_Value_toUpCase()
 
Dim InpRng As Range, Cl As Range
 
Set InpRng = ActiveSheet.Range("C9").CurrentRegion  'A adapter
Debug.Print "Région: ", InpRng.AddressLocal
 
Set InpRng = InpRng.SpecialCells(xlCellTypeConstants)
Debug.Print "Valeur: "; InpRng.AddressLocal
 
For Each Cl In InpRng.Cells
    Debug.Print Cl.Value, Cl.Address
    If Not (IsNumeric(Cl)) Then Cl.Value = UCase(Cl.Value)
Next Cl

[jeromegagne]

Bonjour vinc_bilb,
je ne vois pas trop comment ajouter ton code avec mon code... Désolé mais je suis vraiment novice dans le vba

[patricktoulon]

bonjour
il y avait beaucoup plus simple

1 tester si la cellule contient une formule : en effet si tu a vrai/faux c'est qu'il y a une formule ,dans ce cas la tester
if cells(x,y) hasformula

ou tester directement si il y a vrai ou faux

ensuite pour la conversion

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Cells(x, y).Value = StrConv(Replace(UCase(Cells(x, y)), "A", "A"), vbProperCase)

je pourrait aussi te parler des expressions rationnelles et de sa fonction replace si ca t'interesse bien sur

bref 3 lignes de codes auraient suffit

[Didier Ch.]

Pour quelqu'un de "novice en VBA", il faut traduire :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
   For Each c In Selection
        If Not IsNumeric(c.Value) And Not c.HasFormula() Then
                c.Value = StrConv(Replace(UCase(c.Value), "A", "A"), vbUpperCase)
        End If
    Next c

C'est clairement mieux comme code, merci patricktoulon !
Par contre, @patricktoulon :

1. Cela convertit les é en É, etc. ce qui n'était pas le cas de la macro initiale.
   Une idée pour rester sur l'ancien fonctionnement ? (convertir é en E)
2. Pourquoi ces 3 fonctions imbriquées ?
   Un simple UCase ou StrConv(vbUpperCase) ne suffit pas ?

Merci de tes précisions.

[patricktoulon]

bonsoir didier

oui j'ai cru betement que le ucase ferait sauter les accents

maintenant il y a des solutions
un peu comme celle ci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private Declare Function FoldString Lib "kernel32" Alias "FoldStringA" (ByVal dwMapFlags As Byte, ByVal lpSrcStr As Long, ByVal cchSrc As Long, ByVal lpDestStr As Long, ByVal cchdest As Long) As Long
Function SANSACCENTS(Texte As String) As String
 Dim I As Integer
 SANSACCENTS = Space(Len(Texte))
 For I = 0 To Len(Texte) * 2 - 2 Step 2
  FoldString &H40, StrPtr(Texte) + I, 1, StrPtr(SANSACCENTS) + I, 1
 Next I
SANSACCENTS = UCase(SANSACCENTS)
 End Function
 
Sub test()
 For Each c In Selection
        If Not IsNumeric(c.Value) And Not c.HasFormula() Then
                c.Value = SANSACCENTS(c.Value)
        End If
    Next c
 End Sub

[jeromegagne]

bonsoir patricktoulon,
j'ai testé ce code, mais ca bugue des la premiere ligne, il ne supporte pas ma version 64 bits ...?

[patricktoulon]

re
essai de remplacer la 1 ere ligne par ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
#if win64
Private Declare ptrsafe Function FoldString Lib "kernel32" Alias "FoldStringA" (ByVal dwMapFlags As Byte, ByVal lpSrcStr As Long, ByVal cchSrc As Long, ByVal lpDestStr As Long, ByVal cchdest As Long) As Long
#else
Private Declare Function FoldString Lib "kernel32" Alias "FoldStringA" (ByVal dwMapFlags As Byte, ByVal lpSrcStr As Long, ByVal cchSrc As Long, ByVal lpDestStr As Long, ByVal cchdest As Long) As Long
#end if 

[jeromegagne]

bonsoir didier

oui j'ai cru betement que le ucase ferait sauter les accents

maintenant il y a des solutions
un peu comme celle ci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private Declare Function FoldString Lib "kernel32" Alias "FoldStringA" (ByVal dwMapFlags As Byte, ByVal lpSrcStr As Long, ByVal cchSrc As Long, ByVal lpDestStr As Long, ByVal cchdest As Long) As Long
Function SANSACCENTS(Texte As String) As String
 Dim I As Integer
 SANSACCENTS = Space(Len(Texte))
 For I = 0 To Len(Texte) * 2 - 2 Step 2
  FoldString &H40, StrPtr(Texte) + I, 1, StrPtr(SANSACCENTS) + I, 1
 Next I
SANSACCENTS = UCase(SANSACCENTS)
 End Function
 
Sub test()
 For Each c In Selection
        If Not IsNumeric(c.Value) And Not c.HasFormula() Then
                c.Value = SANSACCENTS(c.Value)
        End If
    Next c
 End Sub

Bonjour Patrick,
pour la version 32 bits je l'ai testé avec un autre ordinateur, elle fonctionne bien sauf que parfois, l'apostrophe se transforme en caractère bizarre :


et encore plus bizarre c'est pas pour tous les apostrophes dans le fichier, L'ALARME ou D'ALARME ne sont pas modifiés.
J'ai aussi ETC... qui se transforme en ETC&
merci pour ton aide.
Jérôme