Uppsala, ungeahnte Problematiken
Hallo Clemens,
ich habe das jetzt mit I und K eingebaut.
Irgendwas klappt da nicht. Weiß nicht obs an meinem Code
liegt, irgendwie spielt da völlig unerwartet der Zeichensatz
o.ä. eine Rolle.
Nachstehend der neue Code.
Das Riesenproblem ist, nehmen wir mal als Beispiel den 10ten
Textblock, da steht in Notepad nach dem Code dann
Just seItzer , dear.
Was ja so aussieht als ob mein Code da unkorrekt gearbeitet
hätte, denn normal müßte da stehen
Just seltzer , dear.
(Was heißt das eigentlich? Liebling ich trink grad
Selterswasser? *gg*)
Kopiere ich das aus Notepad raus nach Word so steht es auch
falsch da.
ABER, kopiere ich es nach Excel so steht da wie gewünscht
seltzer
Also hat mein Code doch funktioniert *rätsel*
Eben habe ich meine neuen Codeteile mal rausgenommen, also der
Code wandelt I nicht in l um.
Das Ergebnis ist gleich. In Notepad und Word wird es falsch
angezeigt, in Excel richtig.
Aaaaah, jetzt habe ich seItzer in Word eingefügt, wird
auch so angezeigt, dann habe ich es markiert und die
Schriftart von Times New Roman auf Arial geändert, schwupps
steht da auch in Word seltzer.
Das klappt auch in Notepad.
Also gib in Notepad Strg+a ein und wähle als
Format–Schriftart Arial.
Sind jetzt alle Probleme gelöst?
Gruß
Reinhard
Option Explicit
'
Sub Umwandeln()
Dim Inh As String, Datei(0) As String, D As Integer, appNB
Datei(0) = "c\test\the sopranos s04e05.srt"
For D = LBound(Datei) To UBound(Datei)
Inh = Einlesen(Datei(0))
Inh = Punkte(Inh)
Inh = Ersetzen(Inh)
Call Schreiben(Inh, Replace(Datei(0), ".srt", "a.srt"))
appNB = Shell("notepad.exe " & Replace(Datei(0), ".srt",
"a.srt"))
Next D
End Sub
'
Function Einlesen(Datei) As String
Dim FF As Long
FF = FreeFile
Einlesen = Space(FileLen(Datei))
Open Datei For Binary As #FF
Get #FF, , Einlesen
Close #FF
End Function
'
Sub Schreiben(ByVal Inh As String, ByVal Datei As String)
Dim FF As Integer
FF = FreeFile
Open Datei For Binary As #FF
Put #FF, , Inh
Close #FF
End Sub
'
Function Punkte(ByVal Inh As String) As String
While InStr(Inh, ". .") \> 0
Inh = Replace(Inh, ". .", "..")
Wend
While InStr(Inh, "....") \> 0
Inh = Replace(Inh, "....", "...")
Wend
Punkte = Inh
End Function
'
Function Ersetzen(ByVal Inh As String) As String
Dim N As Long
Const Gross As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ"
Const Klein As String = "abcdefghijklmnopqrstuvwxyzäöü"
Ersetzen = Replace(Inh, "II", "ll")
Ersetzen = Replace(Ersetzen, "--\>", "##\>")
Ersetzen = Replace(Ersetzen, "--", " -")
Ersetzen = Replace(Ersetzen, "##\>", "--\>")
For N = 2 To Len(Inh)
Select Case Mid(Inh, N, 1)
Case "I"
If InStr(Klein, Mid(Inh, N - 1, 1)) \> 0 And
InStr(Klein, Mid(Inh, N + 1, 1)) \> 0 Then Mid(Inh, N, 1) = "l"
If Mid(Inh, N - 1, 1) = "" And InStr(Klein, Mid(Inh,
N + 1, 1)) \> 0 Then Call Nachfrage
Case "K"
If InStr(Klein, Mid(Inh, N - 1, 1)) \> 0 And
InStr(Klein, Mid(Inh, N + 1, 1)) \> 0 Then Mid(Inh, N, 1) = "l"
If Mid(Inh, N - 1, 1) = "" And InStr(Klein, Mid(Inh,
N + 1, 1)) \> 0 Then Call Nachfrage
End Select
Next N
End Function
'
'- = kleiner Buchstabe
'/ = großer Buchstabe
'\_ = Leerzeichen
'
'großes i
'-I- ? -l-
'\_I- ? nachfragen
'/I und I/ ? nachfragen
'[Satzende]\_I ? keine Aktion
'
'großes K
'-K- ? -k-
'\_K- ? nachfragen
'/K und K/ ? nachfragen
'[Satzende]\_K ? keine Aktion
'
Sub Nachfrage()
MsgBox "ich frag mal nach \*gg\*"
End Sub
))
]