![]() |
|
#1
|
|||
|
|||
|
Hi to all,
After a long time of googling, I'm desperately looking for a function to retrieve high value Unicode for some selected character. Whenever you insert an emoji icon (i.e. 😏) the "Segoe UI Symbol" font will be assigned automatically. As usual you can use «Alt+C» to display the respective Unicode value. There are various functions to retrieve Unicode values, but for these high value Unicode characters they fail: only incorrect or even no values. If you want to search/replace these characters, you can of course copy the character into the S&R dialog and then start S&R – but that approach does not make sense for a VBA solution. You can toggle the character code (Selection.ToggleCharacterCode = «Alt+C») and then use the "1F60F" (= 😏) string for S&R, but that means to walk through the complete document before, select the icon and toggle the code, as the command only works with 'Selection'. Again that does not make sense with VBA. Any help, link or idea would be appreciated. Thanks NP |
|
#2
|
||||
|
||||
|
Perhaps this is what you're after:
Code:
Sub GetSymbolAttributes()
Dim SelFont, SelCharNum
With Selection
With Dialogs(wdDialogInsertSymbol)
SelFont = .Font
SelCharNum = .CharNum
End With
End With
MsgBox SelFont & vbTab & SelCharNum
End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
#3
|
|||
|
|||
|
Hi Paul,
unfortunately this 'old' mvp piece of code does not work for high value Unicode characters. Insert a Symbol: Segoe UI Symbol > Extended Characters - Plane 1 > e.g. smily character code "1F60F". Then run the code and you will get "(normal text)" as Font.Name and a a negative number which cannot be used for further processing. Any other idea ? NP |
|
#4
|
|||
|
|||
|
Admittingly simplistic and perhaps crude, but this might get you what you need:
Code:
Sub ScratchMacro() 'A basic Word macro coded by Greg Maxey Dim strCode As String Selection.ToggleCharacterCode strCode = Selection.Text Selection.ToggleCharacterCode MsgBox strCode End Sub |
|
#5
|
|||
|
|||
|
Hi,
That's exactly what I'm doing right now (see OP), but I hate code using Selection . Unfortunately ToggleCharacterCode only works with Selection.NP
|
|
#6
|
|||
|
|||
|
Sorry! I should have read the OP and not only your reply to Paul and Paul's code. If I find something I will post again.
|
|
#7
|
|||
|
|||
|
Hi,
it took quite some time, but at least I got it (hope so): Code:
Function GetHValUnicode(ByVal sSource) As String
Dim sVal As String, i As Long
sSource = Left(Trim(sSource), 2)
For i = 1 To 2
sVal = sVal & DecodeAscW(Mid$(sSource, i, 1))
If i = 1 Then sVal = sVal & "|"
Next
GetHValUnicode = sVal
End Function
Function DecodeAscW(sChar)
Dim sAscVal As Long
sAscVal = AscW(sChar)
If sAscVal < 0 Then sAscVal = sAscVal + 65536
DecodeAscW = sAscVal
End Function
Sub InsertOrSearchSegoeOISymbol()
Dim vNew As Variant, sSearch As String
vNew = Split(GetHValUnicode(Selection), "|")
' type character
Selection.InsertAfter ChrW(vNew(0)) & ChrW(vNew(1))
' create string for S&R
sSearch = "ChrW(" & vNew(0) & ") & ChrW(" & vNew(1) & ")"
End Sub
NP |
|
#8
|
|||
|
|||
|
NP,
I took some liberties to expand on your work and incorporate it into some other code I had done several years ago which was obviously flawed. Nice job! Code:
Option Explicit
Private Type udtHValChar
CharCodes As String
Hex As String
DecimalLong As String
End Type
Sub GetSymbolData()
Dim myData As DataObject
Dim strCharCode As String, strHex As String
Dim lngANSI As Long
Dim Symbol As udtHValChar
Set myData = New DataObject
Select Case Len(Selection.Range)
Case Is = 0
MsgBox "Nothing selected!"
Exit Sub
Case Is = 1
With Selection
With Dialogs(wdDialogInsertSymbol)
lngANSI = .CharNum
strHex = Hex(lngANSI)
End With
End With
If lngANSI < 128 Then
strCharCode = "^" & CStr(lngANSI)
myData.SetText strCharCode
myData.PutInClipboard
MsgBox "To find this character, use """ & strCharCode & """ in the 'find what' field." & vbCr & vbCr & _
"This has been copied to the clipboard. Use Ctrl+v to paste into the 'find what' field."
End If
If lngANSI > 127 Then
strCharCode = "^u" & CStr(lngANSI)
myData.SetText strCharCode
myData.PutInClipboard
MsgBox "To find this character, use """ & strCharCode & """ in the 'find what' field." & vbCr & vbCr _
& "This has been copied to the clipboard. Use Ctrl+v to paste into the 'find what' field." & vbCr + vbCr _
& "To enter this symbol in the text:" & vbCr + vbCr _
& "Set the NUMLOC key and press ALT + " & lngANSI & vbCr + vbCr _
& "Or, type " & strHex & " and press ALT+X"
End If
Case 2
If AscW(Selection) < 0 Then
Symbol = fcnGetHVals
strCharCode = Symbol.CharCodes
strHex = Symbol.Hex
lngANSI = Symbol.DecimalLong
lngANSI = fcnHexToLong(strHex)
MsgBox "To find this character with VBA, use """ & strCharCode & """ as the Find.Text attribute." & vbCr + vbCr _
& "To enter this symbol in the text:" & vbCr + vbCr _
& "Set the NUMLOC key and press ALT + " & lngANSI & vbCr + vbCr _
& "Or, type " & strHex & " and press ALT+X"
Else
MsgBox "Select only the character to evaluate, and run the macro again"
Exit Sub
End If
Case Else
MsgBox "Select only the character to evaluate, and run the macro again"
End Select
lbl_Exit:
Exit Sub
End Sub
Function fcnGetHVals() As udtHValChar
Dim strSymbol As String, strCharCode As String
Dim varComposite As Variant
Dim lngIndex As Long
Dim lngVal1 As Long, lngVal2 As Long, lngComposite As Long
strSymbol = Left(Trim(Selection), 2)
For lngIndex = 1 To 2
Select Case lngIndex
Case 1
strCharCode = strCharCode & fcnDecodeAscW(Mid$(strSymbol, lngIndex, 1))
strCharCode = strCharCode & "|"
lngVal1 = AscW(Mid$(strSymbol, lngIndex, 1)) + 65536
Case 2
strCharCode = strCharCode & fcnDecodeAscW(Mid$(strSymbol, lngIndex, 1))
lngVal2 = AscW(Mid$(strSymbol, lngIndex, 1)) + 65536
End Select
Next
varComposite = Split(strCharCode, "|")
fcnGetHVals.CharCodes = "ChrW(" & varComposite(0) & ") & ChrW(" & varComposite(1) & ")"
'Insert in text
Selection.InsertAfter ChrW(varComposite(0)) & ChrW(varComposite(1))
lngComposite = lngVal1 + lngVal2 + 16323
fcnGetHVals.Hex = Hex(lngComposite)
fcnGetHVals.DecimalLong = fcnHexToLong(fcnGetHVals.Hex)
End Function
Function fcnDecodeAscW(sChar)
Dim strAscWVal As Long
strAscWVal = AscW(sChar)
If strAscWVal < 0 Then strAscWVal = strAscWVal + 65536
fcnDecodeAscW = strAscWVal
lbl_Exit:
Exit Function
End Function
Function fcnHexToLong(ByVal strIn As String) As Long
On Error Resume Next
fcnHexToLong = Val("&H" & strIn & "&")
If Err Then
On Error GoTo 0
fcnHexToLong = Val("&H" & strIn)
End If
lbl_Exit:
Exit Function
End Function
|
|
#9
|
|||
|
|||
![]() Cheers NP |
|
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
Save Word doc in unicode html (utf-8)
|
rybrns | Word | 5 | 09-26-2011 02:18 PM |
| ANSI-ost to unicode-ost | jeff13 | Outlook | 0 | 01-07-2010 11:48 AM |
| Unicode Big endian support | Rose44 | Excel | 0 | 09-04-2009 11:59 PM |
Unicode Encoding Type
|
Rose44 | Excel | 2 | 08-09-2009 09:05 PM |
| Unicode problem in Subject list | salanalani | Outlook | 0 | 01-20-2006 12:48 PM |