Srt dosyasını macroda metin haline getirebilmek

[Fsmg]

Öncelikle herkese merhaba. Arapça bir srt dosyasını macroyla düz metin haline getiriyorum fakat yazıların tamamı farklı karaktere dönüşüyor. Aynı durumu İngilizce Ve Türkçe yaptığım zaman sıkıntı olmuyor. Ayrıca belirtmem gereken bir nokta var. Arapça dil eklentisi gerek bilgisayarımda gerek office programlarında yüklüdür. Bu konuda yardımcı olursanız çok sevinirim.

 

[Haluk]

Örnek bir dosyayı Google Drive gibi bir yere yüklerseniz, çözüm bulmaya çalışalım....

.

 

[Fsmg]

Örnek bir dosyayı Google Drive gibi bir yere yüklerseniz, çözüm bulmaya çalışalım....

.

Size mail atsam hem orjinal halini hem de macroda uyguladığım halini olur mu? Google drive mevzusu pek kafam almıyor.

 

[Haluk]

Google Drive şart değil, herhangibir sunucuya yükleyebilirsiniz....

.

 

[Fsmg]

Örnek bir dosyayı Google Drive gibi bir yere yüklerseniz, çözüm bulmaya çalışalım....

.

Sub Altyazıları_Tüm_Metin_Yapma()

Range("A:A").ClearContents
dosya = Application.GetOpenFilename(FileFilter:="Altyazı Dosyaları(*.srt),(*srt)", Title:="Alt yazı dosyası seçiniz.")

If dosya = False Then Exit Sub
Open dosya For Input As #1
Do While Not EOF(1)
Line Input #1, Kayit
If Kayit <> Empty And Not IsNumeric(Kayit) And InStr(Kayit, "-->") = 0 Then
metin = metin & Kayit & " "
End If
Loop
Close #1
metin = Replace(metin, Chr(10), " ")
uzunluk = 32767
For a = 0 To Int(Len(metin) / uzunluk)
Cells(a + 1, "A") = Mid(metin, a * uzunluk + 1, uzunluk)
Next

End Sub

ÜSTAT BEN BU KODU KULLANIYORUM VE BU KODA GÖRE YAPTIM.

 

[Haluk]

Ben, bahsettiğiniz türden problemli bir örnek "srt" dosyası görmek istemiştim....

.

 

[Fsmg]

Ben, bahsettiğiniz türden problemli bir örnek "srt" dosyası görmek istemiştim....

.

Umarım istediğiniz dosyayı göndermişimdir.

 

[Haluk]

Şimdi kafam da karıştı...... Sizin probleminiz aşağıdakilerden hangisi?

1) Mevcut bir "srt" dosyasını "txt" dosyasına çevirirken, Arapça karakterler bozuluyor....

2) Arapça karakterler içeren bir Excel dosyasından, "srt" dosyası yaparken oluşan "srt" dosyasındaki Arapça karakterler bozuluyor...

.

 

[Fsmg]

Şimdi kafam da karıştı...... Sizin probleminiz aşağıdakilerden hangisi?

1) Mevcut bir "srt" dosyasını "txt" dosyasına çevirirken, Arapça karakterler bozuluyor....

2) Arapça karakterler içeren bir Excel dosyasından, "srt" dosyası yaparken oluşan "srt" dosyasındaki Arapça karakterler bozuluyor...

.

Birinci şık üstat.

 

[Haluk]

E-postayla gönderdiğiniz "srt" dosyasını Excel'e aktardığımda elde ettiğim görüntü bu;



.

 

[Fsmg]

E-postayla gönderdiğiniz "srt" dosyasını Excel'e aktardığımda elde ettiğim görüntü bu;

Ekli dosyayı görüntüle 222666

.

Hocam öncelikle teşekkür ederim. Yukarıda bir kod yazmıştım o kodla düz metin haline getiriyordum. Ancak istediğim sonuç bu değildi. Normalde gönderdiğiniz resimdeki gibi yapabiliyordum. Macro bana düz metine çevirme imkanı verdiği için orda kullanayım dedim. Ama olmadı. Neyse çok teşekkür ederim.

 

[ÖmerBey]

Haluk Üstat, müsaadenizle cevap vermek istiyorum.,
Bu kodu sanırım ben yazmıştım, altyazı dosyalarını fazlalıklardan arınmış olarak sadece ana metin kalacak şekilde düz yazı haline getirip oradan okumak isteyen bir üyemizdi sanıyorum. Belki de başka bir platforma aktarıyordu, tam hatırlayamadım.
Şöyle bir düzenleme yaptım ama çalışacağından da emin değilim, dener misiniz?

Sub Altyazıları_Tüm_Metin_Yapma()

Range("A:A").ClearContents
dosya = Application.GetOpenFilename(FileFilter:="Altyazı Dosyaları(*.srt),(*srt)", Title:="Alt yazı dosyası seçiniz.")

If dosya = False Then Exit Sub
Set adodb = CreateObject("ADODB.Stream")

adodb.Charset = "utf-8"
adodb.Open
adodb.LoadFromFile (dosya)

Kayit = Split(adodb.ReadText(), Chr(10))
For a = LBound(Kayit) To UBound(Kayit)
    If Kayit(a) <> Empty And Not IsNumeric(Kayit(a)) And InStr(Kayit(a), "-->") = 0 Then
        metin = metin & Application.Trim(Replace(Kayit(a), Chr(13), "")) & " "
    End If
Next

uzunluk = 32767
For a = 0 To Int(Len(metin) / uzunluk)
    Cells(a + 1, "A") = Mid(metin, a * uzunluk + 1, uzunluk)
Next

End Sub

 

[Fsmg]

Haluk Üstat, müsaadenizle cevap vermek istiyorum.,
Bu kodu sanırım ben yazmıştım, altyazı dosyalarını fazlalıklardan arınmış olarak sadece ana metin kalacak şekilde düz yazı haline getirip oradan okumak isteyen bir üyemizdi sanıyorum. Belki de başka bir platforma aktarıyordu, tam hatırlayamadım.
Şöyle bir düzenleme yaptım ama çalışacağından da emin değilim, dener misiniz?

Sub Altyazıları_Tüm_Metin_Yapma()

Range("A:A").ClearContents
dosya = Application.GetOpenFilename(FileFilter:="Altyazı Dosyaları(*.srt),(*srt)", Title:="Alt yazı dosyası seçiniz.")

If dosya = False Then Exit Sub
Set adodb = CreateObject("ADODB.Stream")

adodb.Charset = "utf-8"
adodb.Open
adodb.LoadFromFile (dosya)

Kayit = Split(adodb.ReadText(), Chr(10))
For a = LBound(Kayit) To UBound(Kayit)
    If Kayit(a) <> Empty And Not IsNumeric(Kayit(a)) And InStr(Kayit(a), "-->") = 0 Then
        metin = metin & Kayit(a) & " "
    End If
Next

uzunluk = 32767
For a = 0 To Int(Len(metin) / uzunluk)
    Cells(a + 1, "A") = Mid(metin, a * uzunluk + 1, uzunluk)
Next

End Sub

Hocam çok teşekkür ederim sorun çözüldü. Allah razı olsun. Bu arada evet bu kodu siz paylaştınız. O zaman nicknamenizi hatırlamıyordum. Az önce mesajda belirtince baktım siz paylaşmışsınız. Tekrar tekrar teşekkür ederim. ALLAH RAZI OLSUN.

 

[Fsmg]

فقد وجدت أن من المستحيل تحمّل -
يا فتيات -

عبء المسؤولية الكبير والقيام بواجباتي كملك

كما أتمنى وأرضى


Hocam vermiş olduğunuz koda ekleme yaparak yukarıdaki gibi alt alta olan cümleleri normal tek satır haline getirebilir miyim? Yani tek bir cümle yapabilir miyim?​

 

[Fsmg]

Haluk Üstat, müsaadenizle cevap vermek istiyorum.,
Bu kodu sanırım ben yazmıştım, altyazı dosyalarını fazlalıklardan arınmış olarak sadece ana metin kalacak şekilde düz yazı haline getirip oradan okumak isteyen bir üyemizdi sanıyorum. Belki de başka bir platforma aktarıyordu, tam hatırlayamadım.
Şöyle bir düzenleme yaptım ama çalışacağından da emin değilim, dener misiniz?

Sub Altyazıları_Tüm_Metin_Yapma()

Range("A:A").ClearContents
dosya = Application.GetOpenFilename(FileFilter:="Altyazı Dosyaları(*.srt),(*srt)", Title:="Alt yazı dosyası seçiniz.")

If dosya = False Then Exit Sub
Set adodb = CreateObject("ADODB.Stream")

adodb.Charset = "utf-8"
adodb.Open
adodb.LoadFromFile (dosya)

Kayit = Split(adodb.ReadText(), Chr(10))
For a = LBound(Kayit) To UBound(Kayit)
    If Kayit(a) <> Empty And Not IsNumeric(Kayit(a)) And InStr(Kayit(a), "-->") = 0 Then
        metin = metin & Kayit(a) & " "
    End If
Next

uzunluk = 32767
For a = 0 To Int(Len(metin) / uzunluk)
    Cells(a + 1, "A") = Mid(metin, a * uzunluk + 1, uzunluk)
Next

End Sub

فقد وجدت أن من المستحيل تحمّل -
يا فتيات -

عبء المسؤولية الكبير والقيام بواجباتي كملك

كما أتمنى وأرضى


Hocam vermiş olduğunuz koda ekleme yaparak yukarıdaki gibi alt alta olan cümleleri normal tek satır haline getirebilir miyim? Yani tek bir cümle yapabilir miyim? Mümkün mü?

 

[ÖmerBey]

Yukarıdaki kodu isteğiniz doğrultusunda güncelledim, deneyiniz...

 

[Fsmg]

Yukarıdaki kodu isteğiniz doğrultusunda güncelledim, deneyiniz...

Teşekkür ederim harika oldu. Elinize sağlık.