View Single Post
 
Old 12-14-2014, 12:18 PM
gmaxey gmaxey is offline Windows 7 32bit Office 2010 (Version 14.0)
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,598
gmaxey is just really nicegmaxey is just really nicegmaxey is just really nicegmaxey is just really nicegmaxey is just really nice
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