Macro qui créé des fichiers avec des noms comportant des lettres grecques

Question

Je dispose d'une feuille Excel qui comporte les colonnes suivantes : col A : un nom col B : un texte col C à F différentes valeurs numériques J'ai créé une macro VBA qui parcoure toutes les lignes de la feuille et, pour chaque ligne, effectue les actions suivantes : 1/ fait différents calculs avec les colonnes C à F (et d'autres infos externes) 2/ créé un fichier ayant pour nom le contenu de la col A (suffixé par .txt) 3/ rempli le fichier avec pour première ligne la col B et plusieurs lignes avec les résultats des calculs effectués. Tout marche bien... mais... il se trouve que parfois la colonne A contient des caractères grecs (Unicode/U0370) et du coup les noms de fichiers générés ne sont pas bons. Par exemple : í3.txt au lieu de λ 3.txt (lettre lambda suivi du chiffre 3). On voit qu'il y a un problème Unicode Voici un petit bout du code de la macro: stF = Cells(i_row, 1) & ".txt" f = FreeFile Open stF For Output As #f Print #f, Cells(L_cell, C_cell).Value Print #f, Cells(L_cell, C_cell + 1).Value ... ... etc Close #f Je n'arrive pas à trouver l'astuce pour que le nom du fichier soit exactement le même que le contenu de la col A. Notez que les caractères grecs sont correctement affichés dans la feuillle Excel (bonne police installée). Et aussi que je suis sur PC/Windows 10 et avec Excel 365. Merci par avance pour vos suggestions...

galopin01 · Answer

Je ne vois pas trop comment tester mais essayez de travailler le String et passez le en concaténation avec "ChrW " Voyez ce mot dans l'aide. (consultez celle de libre Office elle est plus explicite que celle de Microsoft...) A+...

galopin01 · Answer

Le problème c'est qu'on ne sait rien de tes String

Tu peux essayer de tester le radical (Cells(i_row, 1) caractère par caractère

avec un Regex (nécessite d'activer "Microsoft VBScript Regular Expression 5.5")

Je ne suis pas certain du fonctionnement avec Unicode... Mais mes tests me semblent crédibles !

Sub test()
Dim Nam$, i%, Z$, Y As Boolean
Y = True
Nam = [B5].Value  'A adapter pour ton test avec Cells(i_row, 1).value
For i = 1 To Len(Nam)
Z = Mid(Nam, i, 1)
Y = OkMot(Z)
If Y = False Then Exit For
Next
If Y Then MsgBox "Ok"
End Sub

Function OkMot(Mot$) As Boolean
'nécessite d'activer "Microsoft VBScript Regular Expression 5.5"
 Dim MyRegExp As RegExp
 Dim myMatches As MatchCollection
 Set MyRegExp = New RegExp
 MyRegExp.Pattern = "[A-Za-z0-9]"
 MyRegExp.ignoreCase = True
 MyRegExp.Global = False
 Set myMatches = MyRegExp.Execute(Mot)
 OkMot = (myMatches.Count = 1)
 Set myMatches = Nothing
 Set MyRegExp = Nothing
End Function

EDIT : On pourrait même sans doute tester l'absence de tout caractère étranger directement dans le mot (donc sans tester caractère par caractère) toujours avec un Regex mais je ne suis pas assez compétents pour te bricoler un Regex comme ça...

A+

galopin01 · Answer

C'est curieux parce que mes tests sont bons. Mais cela provient sans doute de la manière dont j'injecte mes caractères... Peut tu me fournir un fichier avec seulement 2 ou 3 cellules test ? A+...

galopin01 · Answer

J'ai téléchargé la police et pour moi ça marche il me biloque dès A1... J'ai supprimé le # et ça passe... Mais A2 et le reste est bloqué. Donc je suis en mesure de te détecter tous les caractères indésirables donc de te restituer un string sans ces caractères.

Par contre ce que je ne sais pas faire c'est quand il y a juste un caractère grec donc il faut m'expliquer la règle du jeu de nommage s'il n'y a qu'un caractère grec. J'ai compris que la plupart du temps tu te contentes des caractères valides donc je peux te faire une fonction qui te retourne ça mais s'il n'y a que des caractères invalides que faire ?

A+

galopin01 · Answer

Cette fonction te retourne un string ou la lettre grecque est remplacée par un _ suivi de son N° unicode...

Sub test()
Dim i%, Z$
For i = 2 To 26
MsgBox RetNam(Cells(i, 1).Value)
Next
End Sub
Function RetNam$(Cel$)
Dim i%, Tmp$, Z$, Y As Boolean
For i = 1 To Len(Cel)
Z = Mid(Cel, i, 1)
Y = OkMot(Z)
If OkMot(Z) Then
Tmp = Tmp & Z
Else
Tmp = Tmp & "_" & AscW(Z)
End If
Next
RetNam = Tmp
End Function
Function OkMot(Mot$) As Boolean
'nécessite d'activer "Microsoft VBScript Regular Expression 5.5"
 Dim MyRegExp As RegExp
 Dim myMatches As MatchCollection
 Set MyRegExp = New RegExp
 MyRegExp.Pattern = "[A-Za-z0-9]"
 MyRegExp.ignoreCase = True
 MyRegExp.Global = False
 Set myMatches = MyRegExp.Execute(Mot)
 OkMot = (myMatches.Count = 1)
 Set myMatches = Nothing
 Set MyRegExp = Nothing
End Function

A+