DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Teşekkürler Bu şekilde sadece fontunu değiştiriyor cümle anlamını bozuyor.Merhaba
Aşağıdaki linkteki yazı fontunu ekleseseniz istediğiniz olur.
http://www.dafont.com/afarat-ibn-blady.font
Sub Translate_Test()
Dim i As Long
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
Cells(i, "B") = Translate(Cells(i, "A"), "tr", "ar")
Next i
End Sub
Function Translate(kaynak_metin As String, _
Optional kaynak_dil As String = "tr", _
Optional hedef_dil As String = "en") As String
Dim IE As Object, URL As String, res As String
URL = "https://translate.google.com/#" & kaynak_dil & "/" & hedef_dil & "/" & kaynak_metin
Set IE = CreateObject("InternetExplorer.Application")
With IE
.navigate URL
Do Until IE.ReadyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop
res = .Document.all("result_box").innerText
.Quit
End With
Translate = Replace(res, "...", "")
Set IE = Nothing
End Function
Aşağıdaki kodları kullanın.
Translate_Test kodunu butona bağlarsınız.
Kod:Sub Translate_Test() Dim i As Long For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row Cells(i, "B") = Translate(Cells(i, "A"), "tr", "ar") Next i End Sub Function Translate(kaynak_metin As String, _ Optional kaynak_dil As String = "tr", _ Optional hedef_dil As String = "en") As String Dim IE As Object, URL As String, res As String URL = "https://translate.google.com/#" & kaynak_dil & "/" & hedef_dil & "/" & kaynak_metin Set IE = CreateObject("InternetExplorer.Application") With IE .navigate URL Do Until IE.ReadyState = 4: DoEvents: Loop Do While IE.Busy: DoEvents: Loop res = .Document.all("result_box").innerText .Quit End With Translate = Replace(res, "...", "") Set IE = Nothing End Function
.