Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
812to816
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
812to816
812to816
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Format einer mit Open...for output erzeugten Date

Format einer mit Open...for output erzeugten Date
19.10.2006 09:54:22
Markus
Hallo,
kann man das Format einer mit Open file_name_out For Output As #2. von ANSI in UTF-8 ändern? Da Ich die vom Macro erzeugte Datei in einem speziellen Programm verwende, das sonst keine Sonderzeichen anzeigen kann.
Vielen Dank
Markus

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Format einer mit Open...for output erzeugten
20.10.2006 18:42:07
Reinhard
Hi Markus,
bei diesem UTF-8, welche Zeichen sind denn erlaubt/enthalten?

Gruß Reinhard
AW: Format einer mit Open...for output erzeugten Date
20.10.2006 19:56:12
Stefan
Hallo Markus,
Bei der Funktion OpenTextFile koennest Du zwischen ANSI und Unicode waehlen. Hier die Beschreibung der Funktion.
http://www.avhka.de/VBScript/vbs345.htm
Da ich nicht genau weiss ob das Deine Probleme loest, lass ich die Frage noch offen.
Schoene Gruesse
Stefan
ASCII in UTF-8 umwandeln und umgekehrt
21.10.2006 16:22:29
Reinhard
Hallo Stefan, Markus,
ist ja interessant das mit UTF-8:
http://de.wikipedia.org/wiki/Utf-8
Nachfolgende Codes fand ich im Internet. Bei dem einen müßte man noch den Fall von vier Bytes codieren, deshalb Frage noch offen. Getestet habe ich sie nicht.
Bentzen könnte man sie zB so:

Option Explicit
Sub AsciiUtf8()
Dim Satz As String
Close
Open "c:\test\MeineAnsi.txt" For Input As #1
Open "c:\test\MeineUtf8.txt" For Output As #2
While Not EOF(1)
Line Input #1, Satz
Print #2, Encode_UTF8(Satz) ' oder Print #2, Ascii2Utf8(Satz)
Wend
Close
End Sub

Gruß
Reinhard
ps: Ich freue mich über eine Rückmeldung ob diese Antwort hilfreich war oder nicht..
Public Function Ascii2Utf8(Testo As String) As String
Dim J As Integer
Dim Result As String
For J = 1 To Len(Testo)
If Asc(Mid(Testo, J, 1)) > 127 Then
Result = Result + "" + Hex(Asc(Mid(Testo, J, 1))) + ";"
Else
Result = Result + Mid(Testo, J, 1)
End If
Next
Ascii2Utf8 = Result
End Function
'Voilà , j 'avais besoin de convertir de l'UTF-8 en ANSI et après pas mal de recherches
'je n'ai rien trouvé de concluant, donc je l'ai codé à partir de la RFC.
'Je dépose le code ici dans l'espoir que ça puisse un jour servir à quelqu'un.
'Code source libre de droits.
'EDIT: mise à jour de la fonction isUTF8 par une version plus fiable.
Option Explicit
'   Char. number range  |        UTF-8 octet sequence
'      (hexadecimal)    |              (binary)
'   0000 0000-0000 007F | 0xxxxxxx
'   0000 0080-0000 07FF | 110xxxxx 10xxxxxx
'   0000 0800-0000 FFFF | 1110xxxx 10xxxxxx 10xxxxxx
'   the following is not implemented
'   0001 0000-0010 FFFF | 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
Function Encode_UTF8(astr)
Dim c
Dim n
Dim utftext
utftext = ""
n = 1
Do While n <= Len(astr)
c = AscW(Mid(astr, n, 1))
If c < 128 Then
utftext = utftext + Chr(c)
ElseIf ((c > 127) And (c < 2048)) Then
utftext = utftext + Chr(((c \ 64) Or 192))
utftext = utftext + Chr(((c And 63) Or 128))
Else
utftext = utftext + Chr(((c \ 4096) Or 224))
utftext = utftext + Chr((((c \ 64) And 63) Or 128))
utftext = utftext + Chr(((c And 63) Or 128))
End If
n = n + 1
Loop
Encode_UTF8 = utftext
End Function
'   Char. number range  |        UTF-8 octet sequence
'      (hexadecimal)    |              (binary)
'   0000 0000-0000 007F | 0xxxxxxx
'   0000 0080-0000 07FF | 110xxxxx 10xxxxxx
'   0000 0800-0000 FFFF | 1110xxxx 10xxxxxx 10xxxxxx
'   the following is not implemented
'   0001 0000-0010 FFFF | 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
Function Decode_UTF8(astr)
Dim c0, c1, c2, c3
Dim n
Dim unitext
unitext = ""
n = 1
Do While n <= Len(astr)
c0 = Asc(Mid(astr, n, 1))
If n <= Len(astr) - 1 Then
c1 = Asc(Mid(astr, n + 1, 1))
Else
c1 = 0
End If
If n <= Len(astr) - 2 Then
c2 = Asc(Mid(astr, n + 2, 1))
Else
c2 = 0
End If
If (c0 And 224) = 224 And (c1 And 128) = 128 And (c2 And 128) = 128 Then
unitext = unitext + ChrW((c0 And 15) * 4096 Or (c1 And 60) * 64 Or (c1 And 3) * 64 Or (c2 And 63))
n = n + 3
ElseIf (c0 And 192) = 192 And (c1 And 128) = 128 Then
unitext = unitext + ChrW((c0 And 28) * 1024 Or (c0 And 3) * 64 Or (c1 And 63))
n = n + 2
Else
unitext = unitext + ChrW(c0 And 127)
n = n + 1
End If
Loop
Decode_UTF8 = unitext
End Function
'   Char. number range  |        UTF-8 octet sequence
'      (hexadecimal)    |              (binary)
'   0000 0000-0000 007F | 0xxxxxxx
'   0000 0080-0000 07FF | 110xxxxx 10xxxxxx
'   0000 0800-0000 FFFF | 1110xxxx 10xxxxxx 10xxxxxx
'   the following is not implemented
'   0001 0000-0010 FFFF | 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
Function isUTF8(astr)
Dim c0, c1, c2, c3
Dim n
isUTF8 = False
n = 1
Do While n <= Len(astr)
c0 = Asc(Mid(astr, n, 1))
If n <= Len(astr) - 1 Then
c1 = Asc(Mid(astr, n + 1, 1))
Else
c1 = 0
End If
If n <= Len(astr) - 2 Then
c2 = Asc(Mid(astr, n + 2, 1))
Else
c2 = 0
End If
If (((c0 And 224) / 32 = 6) And ((c1 And 192) / 64 = 2)) Or (((c0 And 240) / 16 = 14) And ((c1 And 192) / 64 = 2) And ((c2 And 192) / 64 = 2)) Then
isUTF8 = True
Exit Function
Else
n = n + 1
End If
Loop
End Function

Anzeige

67 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige