Hallo,
die Formel in A1
ergibt das erste von ca. 1.000 Alt-Ägyptischen Hieroglyphen.
Wie kann man diesen UniCode-Wert mit VBA auslesen?
Mein Versuch:
Code:
Sub Read_Unicode()
Dim UC1 As Long, UC2 As Long, ll As Integer, Tx As String
Tx = Cells(2, 2)
ll = Len(Tx)
UC1 = AscW(Left(Tx, 1))
UC2 = AscW(Right(Tx, 1))
Debug.Print ll, UC1, UC2
End Sub
ergibt -10228 -9216
Danke und
mfg
Moin!
Das naheliegendste dürfte folgendes sein:
PHP-Code:
?WorksheetFunction.Unicode(Cells(2, 2))
Gruß Ralf
Hallo Ralf,
die Antwort ist smart.
Meine Überlegung war, ob es auch in Word möglich ist, die Umschreibung in Latein, z.B. ein "n" einzugeben und dann die entsprechende Hieroglype ausgeben kann. Die Worksheet.Function würde das für Excel leisten und mit copy/paste ist eine Übertragung nach Word möglich.
Wenn es gelingen würde die Hieroglyphe mit ChrW zusammenzusetzen, wäre es in Word flexibler.
Danke, aber es gibt noch ein paar Schritte.
mfg
Hallo,
beispielhaft, geht sowas auch mit API. Dafür müsst Du dann die UTF8-Hex-Kodierung (
Beispiel) kennen.
Ggf. kann man ja noch einen Algo schreiben, der die Dezimalzahlen entsprechend umwandelt.
Vielleicht kannst ja darauf aufbauen.
Code:
Option Explicit
Private Declare PtrSafe Function apiMultiByteToWideChar Lib "kernel32" _
Alias "MultiByteToWideChar" (ByVal CodePage As Long, _
ByVal dwFlags As Long, _
ByVal lpMultiByteStr As LongPtr, _
ByVal cchMultiByte As Long, _
ByVal lpWideCharStr As LongPtr, _
ByVal cchWideChar As Long) As Long
Public Function UTF8WriteCharacter(Code As String) As String
Dim c As Long
Dim n As Long
Dim r As String
Dim s As String
Dim b() As Byte
' Validate...
If Not Len(Code) <> 8 Then
' Count...
c = Len(Code) / 2 - 1
' Resize...
ReDim b(0 To c)
' Bytes...
For n = LBound(b) To UBound(b)
b(n) = CLng("&H" & Mid(Code, 2 * n + 1, 2))
Next
' Encode...
n = 0
n = apiMultiByteToWideChar(65001, 0&, VarPtr(b(0)), c + 1, 0&, 0&)
s = String(n, 0)
n = apiMultiByteToWideChar(65001, 0&, VarPtr(b(0)), c + 1, StrPtr(s), n)
r = Left(s, n)
Else
r = ""
End If
' Result...
UTF8WriteCharacter = r
End Function
Public Sub Test()
Cells(1, 8).Value = UTF8WriteCharacter("F0938080")
Cells(1, 9).Value = UTF8WriteCharacter("F0A08098")
End Sub
Gruß
Hallo Mourad,
vielen Dank
in der Liste steht das Zeichen mit &H13000, also dezimal 77824.
Ich dachte eigentlich, dass ich Formate umrechnen könnte, aber wie entsteht
UTF8WriteCharacter("F0938080")
Powershell liefert:
Code:
$Hx = 'F0938080'
[convert]::ToInt32($Hx,16)
# Ergebnis: -258768768
mfg
Soweit bin ich jetzt:
Code:
Sub Read_Unicode()
Dim UC1 As Long, UC2 As Long, ll As Integer, Tx As String
Tx = Cells(2, 2) '77824 &H13000
ll = Len(Tx)
UC1 = AscW(Left(Tx, 1)) '-10228
UC2 = AscW(Right(Tx, 1)) '-9216
Debug.Print ll, UC1, UC2
Range("U2") = ChrW(UC1) & ChrW(UC2)
End Sub
Hallo,
U+13000 entspricht in der
UTF-8-Kodierung: 0xF0 0x93 0x80 0x80. Das Konvertieren von F0938080 in 77824 und vice-versa ist wohl nicht ganz so simpel.
Hier
https://rosettacode.org/wiki/UTF-8_encode_and_decode findest Du weiter unten auch eine VBA-Prozedur, die ich aber nicht ausprobiert habe.
Hinweis: UTF8WriteCharacter() tut's ja erstmal nur für die Unicode-Hex-Codes der Länge 8 und müsste ggf. angepasst werden.
Gruß
Hallo,
ich hoffe, dass ich es geschafft habe:
Mit der Übergabe einer Dezimal-Zahl zwischen 0-1080 wird die entsprechende Hieroglyphe ausgegeben. Es wird kein Excel, sondern "nur" VBA für die Bit-Berechenung und die API von Mourad verwendet.
Die unterste "Sub Einfuegen" gibt im Moment 400 Zeichen aus. Mit dem Wissen der Umschreibung im Latin-Alphabet können später auch einzelne Zeichen an der Stelle des Cursors geschrieben werden.
Danke
mfg
Vielleicht könntest du etwas ausrichten mit:
Code:
Sub M_snb()
ThisDocument.Range.InsertSymbol 31000, "Arial MS unicode", True
End Sub
Word 2010 ist beschränkt auf 32126, neuere Version vielleicht anders.
@snb
Danke
Auch in Office 2019 besteht die Grenze signierten 2 Bytes.
Code:
Sub M_snb1()
ThisDocument.Range.InsertSymbol 77824, "Segoe UI Historic", True
End Sub
Ging leider nicht, auch mit der Ergänzung "unicode"
mfg