Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 12-13-2014, 05:31 AM
NobodysPerfect NobodysPerfect is offline Function to retrieve high value Unicode Windows 8 Function to retrieve high value Unicode Office 2010 32bit
Competent Performer
Function to retrieve high value Unicode
 
Join Date: Jan 2014
Location: Germany
Posts: 136
NobodysPerfect is on a distinguished road
Default Function to retrieve high value Unicode

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
Reply With Quote
  #2  
Old 12-13-2014, 02:23 PM
macropod's Avatar
macropod macropod is online now Function to retrieve high value Unicode Windows 7 64bit Function to retrieve high value Unicode Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,962
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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]
Reply With Quote
  #3  
Old 12-14-2014, 02:54 AM
NobodysPerfect NobodysPerfect is offline Function to retrieve high value Unicode Windows 8 Function to retrieve high value Unicode Office 2010 32bit
Competent Performer
Function to retrieve high value Unicode
 
Join Date: Jan 2014
Location: Germany
Posts: 136
NobodysPerfect is on a distinguished road
Default

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
Reply With Quote
  #4  
Old 12-14-2014, 07:31 AM
gmaxey gmaxey is offline Function to retrieve high value Unicode Windows 7 32bit Function to retrieve high value Unicode Office 2010 (Version 14.0)
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,440
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

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
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
  #5  
Old 12-14-2014, 07:48 AM
NobodysPerfect NobodysPerfect is offline Function to retrieve high value Unicode Windows 8 Function to retrieve high value Unicode Office 2010 32bit
Competent Performer
Function to retrieve high value Unicode
 
Join Date: Jan 2014
Location: Germany
Posts: 136
NobodysPerfect is on a distinguished road
Default

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
Reply With Quote
  #6  
Old 12-14-2014, 07:54 AM
gmaxey gmaxey is offline Function to retrieve high value Unicode Windows 7 32bit Function to retrieve high value Unicode Office 2010 (Version 14.0)
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,440
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

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.
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
  #7  
Old 12-14-2014, 09:29 AM
NobodysPerfect NobodysPerfect is offline Function to retrieve high value Unicode Windows 8 Function to retrieve high value Unicode Office 2010 32bit
Competent Performer
Function to retrieve high value Unicode
 
Join Date: Jan 2014
Location: Germany
Posts: 136
NobodysPerfect is on a distinguished road
Default

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
Cheers
NP
Reply With Quote
  #8  
Old 12-14-2014, 12:18 PM
gmaxey gmaxey is offline Function to retrieve high value Unicode Windows 7 32bit Function to retrieve high value Unicode Office 2010 (Version 14.0)
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,440
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

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
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
  #9  
Old 12-14-2014, 01:54 PM
NobodysPerfect NobodysPerfect is offline Function to retrieve high value Unicode Windows 8 Function to retrieve high value Unicode Office 2010 32bit
Competent Performer
Function to retrieve high value Unicode
 
Join Date: Jan 2014
Location: Germany
Posts: 136
NobodysPerfect is on a distinguished road
Default






Cheers
NP
Reply With Quote
Reply



Similar Threads
Thread Thread Starter Forum Replies Last Post
Function to retrieve high value Unicode 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
Function to retrieve high value Unicode 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

Other Forums: Access Forums

All times are GMT -7. The time now is 07:26 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft