Function to retrieve high value Unicode

[NobodysPerfect]

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

[macropod]

Perhaps this is what you're after:

Sub GetSymbolAttributes()
Dim SelFont, SelCharNum
With Selection
  With Dialogs(wdDialogInsertSymbol)
    SelFont = .Font
    SelCharNum = .CharNum
  End With
End With
MsgBox SelFont & vbTab & SelCharNum
End Sub

[NobodysPerfect]

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

[gmaxey]

Admittingly simplistic and perhaps crude, but this might get you what you need:

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

[NobodysPerfect]

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

[gmaxey]

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.

[NobodysPerfect]

Hi,

it took quite some time, but at least I got it (hope so):

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

Cheers
NP

[gmaxey]

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!

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

[NobodysPerfect]

Cheers
NP