XL 2013 Carcatères Unicode vers arabe / birman / autre

Option Explicit

Function ConvChr2(ByVal Z As String) As String
Dim T() As String, N&
On Error Resume Next
T = Split(Z, "<U+")
For N = 1 To UBound(T)
   T(N) = ChrW$(CLng("&H" & Left$(T(N), 4))) & Mid$(T(N), 6)
   Next N
ConvChr2 = Join(T, "")
End Function

Option Explicit

Function StrUPlus(ByVal Z As String) As String
Dim T() As String, N&, P&
On Error Resume Next
T = Split(Z, "<U+")
For N = 1 To UBound(T)
   P = InStr(T(N), ">")
   T(N) = ChrW$(CLng("&H" & Left$(T(N), P - 1))) & Mid$(T(N), P + 1)
   Next N
StrUPlus = Join(T, "")
End Function

Function UPlusStr(ByVal Z As String) As String
Dim P&, Cod&
For P = Len(Z) To 1 Step -1
   Cod = AscW(Mid$(Z, P, 1)) And &HFFFF&
   If Cod > &HFF Then Z = Left$(Z, P - 1) & "<U+" & Right$("0000" & Hex$(Cod), 4) & ">" & Mid$(Z, P + 1)
   Next P
UPlusStr = Z
End Function