• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

Katılım
15 Ocak 2010
Mesajlar
99
Excel Vers. ve Dili
Libre Office Türkçe
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 etmiştim. Sağolsun Mustafa Altun bey bu isteğimi yazdığı makro programıyla yerine getirmeye çalıştı. Ancak bu makro programı
http://s7.dosya.tc/server2/dpt3s5/ORNEK.docx.html URL adresinde yer alan Word dosyasında düzgün netice vermedi. Bu sebeple, bu makro programını düzeltmenizi sizlerden istirham ediyorum.

Makro programının kodları:

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
 
Merhaba, Halit bey. İlginizden ötürü size çok teşekkür ederim. O belirttiğiniz linkteki soruma dair en son sayfada o Word dosyasının URL adresini koydum.
 
Geri
Üst