Altyazıları tüm metin yapma

[extremetonic]

Merhaba. Altyazı dosyası içindeki (.srt) video altyazılarını bir macro ile düz metin haline getirebilir miyiz? Örneklersem;

1
00:00:06,612 --> 00:00:12,619
An estimated 20 million cases of blindness
worldwide are caused by cataracts,

2
00:00:12,619 --> 00:00:19,215
a curable condition affecting the lens
that focuses images onto the eye's retina.

3
00:00:19,215 --> 00:00:23,678
A cataract occurs when proteins
in the lens lose their normal arrangement,

şeklindeki altyazıları

An estimated 20 million cases of blindness worldwide are caused by cataracts, a curable condition affecting the lens that focuses images onto the eye's retina. A cataract occurs when proteins in the lens lose their normal arrangement,

şeklinde düz metin yapmak istiyorum. Böylece bu metinleri direk olarak okuyabileceğim. Ama düz metne geçirilirken altyazıdaki her satır sonrasında bir boşluk konması gerekiyor ki bu sayede kelimeler bitişik olmasın.

Bunun için bir macro yapılabilir mi? Teşekkürler.

 

[extremetonic]

Mümkün değil mi bunu yapması? :???:

 

[ÖmerBey]

Merhaba,
Aşağıdaki kodu çalıştırıp açılan pencereden .srt uzantılı altyazı dosyanızı seçip deneyiniz.

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

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

End Sub

 

[extremetonic]

Çok teşekkürler mucit77 :dua2: :icelim:
Excelden kopyalayıp worde aktardığımda aşağıdaki resimde olduğu gibi görünüyor. Eğer mümkünse bunu tam düz yazı olarak çevirme imkanım var mı? Yani aslında satıra sığıyorken alt satıra geçiyor. Olursa daha güzel olur, olmazda da çok yardımcı oldun teşekkürler

 

[ÖmerBey]

Ben denedim fakat bahsettiğiniz problem ben de yok.
Yine de koddaki ilgili yere aşağıdaki kırmızı satırı ilave edip deneyiniz.

Close #1
[COLOR="Red"]metin = Replace(metin, Chr(10), " ")[/COLOR]
uzunluk = 32767

Eğer yine düzelmezse altyazı dosyanızı paylaşın.

 

[extremetonic]

Bu satırı ekleyince düzeldi ve tam istediğim gibi oldu mucit77, emeğin için çok teşekkürler :dua2: :icelim:

 

[ÖmerBey]

Rica ederim,
İyi akşamlar, iyi çalışmalar...

 

[extremetonic]

Merhaba, aşağıdaki macro kodu ile seçtiğim srt dosyalarını düz metine çevirebiliyorum. Ama bazı dosyalarda dille ilgili sorun çıkarıyor, bazı harfleri karakter olarak çıkarıyor. Türkçe ç,ğ,ş gibi harflere başka karakter, ingilizce ve almancada da başka karakterler çıkarıyor. Bunu nasıl düzeltebilirim?

Teşekkürler.

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

 

[extremetonic]

Çözüm yok mu ustalar

 

[extremetonic]

Sevgili dostlar, bilen yok mu? Macroya ihtiyacım var