Emoji et formule/VBA

Version imprimable

15/03/2025, 09h43
tototiti2008

Emoji et formule/VBA

Bonjour,

Je suis sur Excel 2021 (pas dans la liste des versions...)
Depuis les dernières versions de Windows, il est possible d'accéder à des emojis un peu partout ( raccourcis Windows + ; )
Ils s'intègrent plus ou moins bien dans les applications Office et peuvent avoir des apparences changeantes selon le programme
Cependant, j'ai essayé et ils peuvent s'intégrer à des formules et ça marche bien
par exemple

Code:

=SI(G12>5;"😊";"😐")

Par contre, si j'essaie de faire écrire ce type de formule par VBA, là ça pose soucis

Code:

ActiveCell.FormulaR1C1 = "=IF(RC[1]>5,""??"",""??"")"

la fonction CODE renvoie 63 pour n'importe quel Emoji (en tout cas ceux que j'ai testé), une idée pour faire écrire la bonne formule par VBA ?
15/03/2025, 10h51
Invité
L'EDI vba ne supporte pas le texte widestring UTF-16 présent depuis win98 alors que dire du texte Unicode UTF-32 codé sur 4 octets .. la solution est d'utiliser deux ChrW pour codé un caractère Unicode sous forme de pair surrogate pour savoir lesquels tester avec ce code
placer l'emoji dans la cellule A1
Code:

1 2 3 Dim t As String t = Range("A1") MsgBox AscW(Mid(t, 1, 1)) & " " & AscW(Mid(t, 2, 1))

Bonjour,

Merci beaucoup
Je dois avouer qu'en matière d'encodage de texte je suis un peu aux fraises, faut dire que c'est pas super simple

une macro à l'arrache qui écrirait donc une formule avec des émojis si les émojis à utiliser étaient mis au préalable en A1 et A2, sur la base de ta réponse
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Sub test() Dim t As String, Code1 As Long, Code2 As Long, Code3 As Long, Code4 As Long t = Range("A1") Code1 = AscW(Mid(t, 1, 1)) Code2 = AscW(Mid(t, 2, 1)) t = Range("A2") Code3 = AscW(Mid(t, 1, 1)) Code4 = AscW(Mid(t, 2, 1)) range("A3").FormulaR1C1 = "=IF(RC[1]>5,""" & ChrW(Code1) & ChrW(Code2) & """,""" & ChrW(Code3) & ChrW(Code4) & """)" End Sub

15/03/2025, 12h00
Invité

Faites attention pas tous les emoji sont présentés en un seul caractère Unicode certains contiennent plus, d'autres sont personnalisables selon le genre la couleur de peau ou la couleur, les drapeaux sont aussi codés sur deux cataractes Unicode dans ces cas il faut copier l'ensemble de la séquence
15/03/2025, 18h12
tototiti2008

1 pièce(s) jointe(s)

Re,

Ok, merci

une petite fonction pour déterminer les codes des Emojis

J'ai ajouté une nouvelle colonne pour afficher le codepoint exacte pour chaque emoji pour pouvoir les consulter sur le web et aquérir d'avantage d'infos, les valeurs sont en hexadécimal.

👧🏼 4 -10179, -9113, -10180, -8196 1F467, 1F3FC
🤴🏿 4 -10178, -8908, -10180, -8193 1F934, 1F3FF
😂 2 -10179, -8702 1F602

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Function ListCodeU(Emoj As String) As String
Dim I As Integer, nCount As Integer
Dim CodePoint As Long, L As Long
   nCount = Len(Emoj)
   I = 1
   While I <= nCount
       If I > 1 Then ListCodeU = ListCodeU & ", "
       CodePoint = AscW(Mid(Emoj, I, 1)) And &HFFFF&
       If (CodePoint >= &HD800&) And (CodePoint <= &HDBFF&) Then
           If I = nCount Then GoTo mEnd
           L = AscW(Mid(Emoj, I + 1, 1)) And &HFFFF&
           If (L >= &HDC00&) And (L <= &HDFFF&) Then
              CodePoint = (CodePoint And &H3FF&) * 1024
              CodePoint = (CodePoint Or (L And &H3FF&)) + &H10000
              I = I + 1
           End If
       End If
mEnd: I = I + 1
       ListCodeU = ListCodeU & Hex(CodePoint)
   Wend
End Function