Hallo,
ich muß in ein Tabellenblatt eine mehrzeilige Unicode Textdatei mit griechischen Buchstaben einlesen.
Das einlesen an sich funktioniert ich bekomme nur keine griechischen Buchstaben in den einzelnen Zellen angezeigt. Es wäre auch mal möglich, daß die Textdatei in kirillisch oder arabisch ist.
Soviel ich weiß kann eine Zelle nur 255 Zeichen. Liegt es daran?
Kann man das irgendwie umgehen?
Für Hilfe wäre ich sehr dankbar!
Hier der Code der mir den Text einlesen soll.
Sub przdTextLesen()
'Bildschirmaktualisierung aus
Application.ScreenUpdating = False
'Tabellenüberschrift formatieren
With ActiveSheet
With .Cells(1, Startspalte)
.Value = "Sprache " & Startspalte - 1
.ColumnWidth = 45
End With
.Cells(2, Startspalte).Value = NameTextDatei
End With
'Startvariablen festlegen
StartZeile = 3
SchlTextSpalte = 1
posStart = 1
'Ermittlung freier Datenkanal
fDatenKanal = FreeFile
'Datenkanal schliessen, wenn offen
Close #fDatenKanal
'freier Datenkanal für ausgewählte Datei zum lesen öffnen
Open PfadMitDatei For Input As #fDatenKanal
'Schleife bis Ende der Texdatei erreicht ist
Do While Not EOF(fDatenKanal)
'Lesen der Textzeilen aus Textdatei
Line Input #fDatenKanal, sText
sText = fctFromUniCodeString(sText)
'Sonderzeichen entfernen
If InStr(1, sText, Chr(255) & Chr(254)) > 0 Then
sText = Replace(sText, Chr(255) & Chr(254), „“)
End If
'Starposition Trennzeichen ermittlen
posStart = InStr(1, sText, „|“)
'Stopposition ermitteln
posStop = Len(sText)
'ermittelte Texte in Variablen übernehmen
nText(1) = Left(sText, posStart - 1)
nText(2) = Right(sText, posStop - posStart)
'nach Schlüsseltext suchen und dann in entsprechende Zeile Text übernehmen
sTextZeile = fctZeigerSchluesseltext(ActiveSheet.Name, nText(1), StartZeile, maxZeile, 1)
'Schlüsseltext nicht gefunden
If sTextZeile > maxZeile Then GoTo NextZeile
On Error Resume Next
'Texte aus Variablen in Zellen übernehmen und Zeilenumbruch aktivieren
With ActiveSheet.Cells(sTextZeile, Startspalte)
.Value = nText(2)
.WrapText = True
End With
'Text Statusanzeige zuweisen
frmStatus.lbStatus.Caption = "Text zu " & Int(StartZeile * 100 / maxZeile) & "% eingelesen aus " & NameTextDatei & „.txt“
'Übergabe der Steuerung an Betriebssystem
DoEvents
StartZeile = StartZeile + 1
NextZeile:
Loop
'Datenkanal wieder schliessen
Close #fDatenKanal
End Sub
Public Function fctFromUniCodeString(Text As String) As String
Dim i As Integer ’ Zähler über die einzelnen Bytes des Unicode-Strings
fctFromUniCodeString = „“
For i = 1 To LenB(Text)
fctFromUniCodeString = Replace(fctFromUniCodeString & ChrW(AscB(MidB(Text, i, 1))), Chr(0), „“)
DoEvents
Next
End Function
Gruß
Rainer
