Metni Resim Formatına Dönüştürme

[VeliDemir]

Merhaba. Bir Word belgesinde yer alan A'den Z'ye kadar olan harfler haricindeki karakterleri metin biçiminden resim biçimine dönüştüren bir makro programını sizlerden rica ediyorum. Teşekkür ederim.

 

[leumruk]

Selamlar,
Örnek bir dosya ekler misiniz? Deneme yapmadan çözüm bulamayız.

 

[VeliDemir]

Örnek olarak aşağıda belirttiğim Word metnindeki Latin harfleriyle yazılı olanların haricindekileri yazı formatından resim formatına çeviren bir makro programını sizden rica ediyorum.

Örnek

Her zîhayat senin temaşageh-i san'atın olan zemin yüzüne her yerden çıkıp bakıyorlar.

ﺯِﻧِﺸِﻴﺐُ ﺍَﺯْ ﻓِﺮَﺍﺯِﻯ ﻣَﺎﻧَﻨْﺪِ ﺩَﻟﺎَّﻟﺎَﻥْ ﺑِﻨِﺪَﺍﺀِ ﺑِﺂﻭَﺍﺯِﻯ

Aşağıdan, yukarıdan dellâllar gibi çıkıp bağırıyorlar.
ﺩَﻡْ ﺩَﻡْ ﺯِﺟَﻤَﺎﻝِ ﻧَﻘْﺶِ ﺗُﻮ ﴿ﻧُﺴْﺨَﻪ: ﺯِﻫَﻮَﺍﻯِ ﺷَﻮْﻕِ ﺗُﻮ﴾ ﺩَﺭْ ﺭَﻗْﺺ ﺑَﺎﺯِﻯ

Senin cemal-i nakşından keyiflenip, o dellâl-misal ağaçlar oynuyorlar.
ﺯِﻛَﻤَﺎﻝِ ﺻُﻨْﻊِ ﺗُﻮ ﺧُﻮﺵْ ﺧُﻮﺵْ ﺑِﮕَﺎﺯِﻯ

Senin kemal-i san'atından neş'elenip, güzel güzel sadâ veriyorlar.

 

[leumruk]

Veli Bey,
Sanırım Word dosyasında metinleriniz... Deneme yapabilmemiz için örnek dosya eklemelisiniz. İstediğiniz şey örnek dosya olmadan çözülebilecek bir konu değil.
Buradan ekleyebilirsiniz: http://s7.dosya.tc/

 

[Haluk]

Veli Bey,
Deneme yapabilmemiz için örnek dosya eklemelisiniz.

Mesajdan kopyalayıp Word'e yapıştırabilirsiniz ...

.

 

[Haluk]

Örnek olarak aşağıda belirttiğim Word metnindeki Latin harfleriyle yazılı olanların haricindekileri yazı formatından resim formatına çeviren bir makro programını sizden rica ediyorum.

Bu işi manuel olarak yapmak isterseniz;

Word dokümanını kopyalayıp, yeni bir Excel dokümanı açtıktan sonra Paste Special (Özel Yapıştır) menüsünden Picture (Resim) seçerek yaptığınızda, tüm doküman Excel'de resim olarak yer alır.

Bu dosyayı kaydettiğinizde, tablet vs cihazlarda görüntülenebilir mi .... onu denemek lazım.

Eğer bu çözüm işinize yararsa, bunun makrosu yazılır....

.

 

[leumruk]

Mesajdan kopyalayıp Word'e yapıştırabilirsiniz ...

.

Haluk Bey,
Ben de Edebiyat bölümü mezunu olduğum için, arkadaşımızın ne istediğini hemen hemen anlayabiliyorum.

Latin harfleriyle oluşturulmuş bir metnin içinde bulunan Osmanlıca metinleri; "elinde bulunan e-kitap okuyucular görüntüleyemediği için" kelime kelime resme çevirmek istiyor. Tabi bu resimler metnin içinde metin gibi görünecek.

Makro yazabilmem için kullanılan fontun ne olduğunu, metinlerin yerleşim biçimlerini görmem gerekiyor.
Israrla örnek dosya istememin sebebi budur.

Bu da Veli Bey'in isteğini daha açık bir biçimde anlattığı konu başlığı: http://www.excel.web.tr/f48/worddeki-osmanlyca-metinler-t170002.html

 

[VeliDemir]

Merhaba.

http://s7.dosya.tc/server2/067txq/ORNEK.docx.html URL adresine ORNEK.docx dosyasını yükledim.

İlginizden ötürü teşekkür ederim.

 

[leumruk]

Selamlar,
Arapça harfleriniz "Times New Roman"; latin harfleriniz Georgia...
Örnek dosyanızdaki bilgilerden hareketle örnek dosyayı deneyiniz.

Sub Osmanlica_Metin()
Set wd = CreateObject("word.Application")
wd.Visible = True
yol = ThisWorkbook.Path & "\ORNEK.docx"
wd.Application.Documents.Open yol
fnt = "Times New Roman"
knt = False
If ActiveWindow.DisplayGridlines = True Then
ActiveWindow.DisplayGridlines = False
End If
On Error GoTo bitir
For x = 1 To wd.ActiveDocument.Characters.Count
If wd.ActiveDocument.Characters(x).Font.Name = fnt And knt = False Then
knt = True
ilk = x - 1
End If
If ilk > 0 And knt = True Then
    If wd.ActiveDocument.Characters(x).Font.Name <> fnt Then
        son = x - 1
        wd.ActiveDocument.Range(Start:=ilk, End:=son).Copy
        Range("h1").Select
        Columns("H:H").ColumnWidth = 180
        ActiveSheet.PasteSpecial Format:="HTML"
        Columns("H:H").EntireColumn.AutoFit
        Rows("1:1").EntireRow.AutoFit
        Range("h1").Font.Bold = True
        Range("h1").CopyPicture
        wd.ActiveDocument.Range(Start:=ilk, End:=son).Paste
        Application.CutCopyMode = False
        son = 0: ilk = 0: knt = False
    End If
End If
Next
bitir:
MsgBox "İşlem tamam.", vbInformation, "leumruk"

End Sub

UYARILAR:
1) %90'nın üzerinde doğruluk payı var. Bazı satırlarda harfleri atlayabiliyor. Kendi dosyanızda deneyin verdiğiniz bilgilere göre düzenleme yapılabilir.
2) Excel üzerinden bir çalışma yaptım. Excel dosyası ile örnek dosya aynı klasörde olmalı.
3)Dosya yolunda ORNEK.docx yazıyor. Buraya kendi dosyanızın adını yazınız.

Bunun dışında e-kitap okuyucularla meşgul olmuş biri olarak şunu da tavsiye edebilirim:
Word belgenizin sayfa ayarlarını ekitap okuyucunuzun ekran boyutuna göre ayarlayın, kenar boşluklarını sıfırlayın. Sonrasında PDF olarak kaydedin. E-kitap okuyucunuzda Pdf formatındaki dosyaların formatı bozulmayacaktır.

İkinci önerim: Android işlemcili bir ekitap okuyucu almanız. Böylece dosyaları düzenlemek zorunda kalmazsınız. Her formatı rahatlıkla okuyabilirsiniz.

Onyx Books ve Boyue markalarını inceleyebilirsiniz.

 

[VeliDemir]

Merhaba. Yardımınızdan dolayı size çok teşekkür ederim. Zamanında Amazon Kindle e-kitap okuyuyusu satın aldığıma pişman oldum. Eğer bir sorunla karşılarsam, size bildirimde bulunacağım. Hayırlı geceler.

 

[VeliDemir]

Merhaba.
http://s7.dosya.tc/server2/dpt3s5/ORNEK.docx.html URL adresinde yer alan Word dosyasında geliştirdiğiniz makro programı çalışmadı maalesef. Bunu düzeltmenizi sizden rica ediyorum. Hayırlı geceler.

 

[leumruk]

Selamlar,
Dosyalarınızın içeriğine göre kodların düzenlenmesi gerekir. Verdiğiniz örneğe göre düzenlenmiş kod:

Sub Osmanlica_Metin1()
Set wd = CreateObject("word.Application")
wd.Visible = True
yol = ThisWorkbook.Path & "\ORNEK.docx"
wd.Application.Documents.Open yol
fnt = "Times New Roman"
knt = False
If ActiveWindow.DisplayGridlines = True Then
ActiveWindow.DisplayGridlines = False
End If
For x = wd.ActiveDocument.Characters.Count To 1 Step -1
krktr = wd.ActiveDocument.Characters(x).Font.Name
If krktr = fnt And knt = False Then
knt = True
son = wd.ActiveDocument.Characters(x).End
prg = wd.ActiveDocument.Range(0, wd.ActiveDocument.Characters(x).Start).Paragraphs.Count
End If
If son > 0 And knt = True Then
onprg = wd.ActiveDocument.Range(0, wd.ActiveDocument.Characters(x).Start).Paragraphs.Count
If krktr <> fnt And wd.ActiveDocument.Characters(x).Text <> " " Or prg > onprg Or prg = 1 And x = 1 Then
        ilk = wd.ActiveDocument.Characters(x).Start
        If krktr <> fnt Then ilk = wd.ActiveDocument.Characters(x).End
        wd.ActiveDocument.Range(Start:=ilk, End:=son).Copy
        Range("h1").Select
        Columns("H:H").ColumnWidth = 180
        ActiveSheet.PasteSpecial Format:="HTML"
        Range("h1") = Trim(Range("h1"))
        Range("h1").Font.Size = 17
        Range("h1").Font.Name = "Times New Roman"
        Columns("H:H").EntireColumn.AutoFit
        Rows("1:1").EntireRow.AutoFit
        Range("h1").Font.ColorIndex = 3
        Range("h1").CopyPicture
        wd.ActiveDocument.Range(Start:=ilk, End:=son).Paste
        Application.CutCopyMode = False
        son = 0: ilk = 0: knt = False
End If
End If
Next
bitir:
MsgBox "İşlem tamam.", vbInformation, "leumruk"
End Sub

 

[VeliDemir]

Çok teşekkür ederim.