Mrrrr's Forum (VIEW ONLY)
Un forum care ofera solutii pentru unele probleme legate in general de PC. Pe langa solutii, aici puteti gasi si alte lucruri interesante // A forum that offers solutions to some PC related issues. Besides these, here you can find more interesting stuff.
|
Lista Forumurilor Pe Tematici
|
Mrrrr's Forum (VIEW ONLY) | Reguli | Inregistrare | Login
POZE MRRRR'S FORUM (VIEW ONLY)
Nu sunteti logat.
|
Nou pe simpatie:
Dulci-k pe Simpatie.ro
 | Femeie
22 ani
Giurgiu
cauta Barbat
22 - 45 ani |
|
Mrrrr
AdMiN
 Inregistrat: acum 17 ani
Postari: 2186
|
|
Put in PERSONAL.XLSB then use with =PERSONAL.XLSB!function_name()
Function UTF16encode(ByVal unicode_code_point)
If (unicode_code_point >= 0 And unicode_code_point <= &HD7FF&) Or (unicode_code_point >= &HE000& And unicode_code_point <= &HFFFF&) Then
UTF16encode = ChrW(unicode_code_point)
Else
unicode_code_point = unicode_code_point - &H10000
UTF16encode = ChrW(&HD800 Or (unicode_code_point \ &H400&)) & ChrW(&HDC00 Or (unicode_code_point And &H3FF&))
End If
End Function
Function HTMLdecode(sText)
' REFERENCE: Microsoft VBScript Regular Expression 5.5.
Dim regEx
Dim matches
Dim match
sText = Replace(sText, """, Chr(34))
sText = Replace(sText, "<", Chr(60))
sText = Replace(sText, ">", Chr(62))
sText = Replace(sText, "&", Chr(38))
sText = Replace(sText, " ", Chr(32))
Set regEx = New RegExp
With regEx
.Pattern = "&#(\d+);" 'Match html unicode escapes
.Global = True
End With
Set matches = regEx.Execute(sText)
'Iterate over matches
For Each match In matches
'For each unicode match, replace the whole match, with the ChrW of the digits.
sText = Replace(sText, match.Value, UTF16encode(CLng(match.SubMatches(0))))
Next
HTMLdecode = sText
End Function |
Either use UTF16encode function:
Eg. =PERSONAL.XLSB!UTF16encode(127757) returns 🌍
Or use HTMLdecode function:
Eg. =PERSONAL.XLSB!HTMLdecode("🌍") returns 🌍
Source:
Use with:
_______________________________________
|
|
| pus acum 2 luni |
|
Mrrrr
AdMiN
Inregistrat: acum 17 ani
Postari: 2186
|
|
More conversions in VBA:
_______________________________________
|
|
| pus acum 2 luni |
|
Mrrrr
AdMiN
Inregistrat: acum 17 ani
Postari: 2186
|
|
To find UTF-16 hex codes for VBA, search characters like U+1F643 with:
The above U+1F643 converts to 0xD83D 0xDE43 which in VBA translates to ChrW(&HD83D) & ChrW(&HDE43)
Source of fileformat site:
_______________________________________
|
|
| pus acum 2 luni |
|
Mrrrr
AdMiN
Inregistrat: acum 17 ani
Postari: 2186
|
|
Convert graphical smiley from cell to usable ChrW codes:
Sub Convert_Active_Cell_Smiley()
Dim s
s = ActiveCell
Dim i As Long
For i = 1 To Len(s)
Dim c
c = Mid(s, i, 1)
Debug.Print i, c, AscW(c)
Next i
End Sub |
For the following smiley: 🙃
HTML Entity (decimal) encoding: 🙃
Unicode encoding: U+1F643
The above snippet returns:
Code:
1 ? -10179
2 ? -8637 |
Which can be used in VBA like this: ChrW(-10179) & ChrW(-8637)
Source:
_______________________________________
|
|
| pus acum 2 luni |
|