Divi Word makrosi, kas varētu noderēt tiem, kam nav instalēta Tildes vārdnīca, bet ir pieejams internets.
Lai lietotu, makrosu projektiem referencēs jāpieliek Microsoft XML (es liku V 6.0, bet derēs jebkurš). Pēc tam atliek uzbindēt klaviatūras saīsni. Piemēram, es ieliku Shift+Ctrl+Alt+E tulkojumam uz angļu valodu un Shift+Ctrl+Alt+L tulkojumam uz latviešu valodu. Pēc tam, kad vajag tulkojumu, iezīmējam tulkojamo vārdu un izpildām klaviatūras maģiju.
Uzskatu, ka SIA “Tilde” tiesības ar šo neesmu pārkāpis, jo esmu tikai vienkāršojis piekļuvi datiem, kas ir publiski pieejami.
Rezultāts izskatās šādi:
'tulko iezīmēto tekstu uz angļu valodu
Sub TranslateToEn()
Dim sRes As String
sRes = Translate("L", GetSelection())
If TrimEnd(sRes) <> "" Then MsgBox sRes
End Sub
'tulko iezīmēto tekstu uz angļu valodu
Sub TranslateToLV()
Dim sRes As String
sRes = Translate("E", GetSelection())
If TrimEnd(sRes) <> "" Then MsgBox sRes
End Sub
'ielasa iezīmēto vārdu vai vārdu pirms kursora
Public Function GetSelection() As String
Dim sTran As String
If TrimEnd(Selection.Text) <> "" Then
sTran = Trim(Selection.Text)
Else
Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
sTran = Trim(Selection.Text)
Selection.MoveRight Unit:=wdCharacter, Count:=1
End If
GetSelection = sTran
End Function
'izpilda tulkošanas darbu
Function Translate(ByVal spDirection As String, ByVal spText As String) As String
Dim oXML As New XMLHTTP
Dim sPost As String
Dim sResponse As String
If TrimEnd(spText) = "" Then Exit Function
sPost = "MfcISAPICommand=Translate" & spDirection & _
"&ApostrofeMode=0&DictionaryView=1&WholeWordsCheckBox=1&EditLine=" & _
URLEncode(spText)
'nolasa rezultātus no servera
Call oXML.Open("POST", "http://dictionary.tilde.lv/idiction.dll?", False)
Call oXML.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
Call oXML.setRequestHeader("Encoding", "Windows-1257")
oXML.send (sPost)
sResponse = ToChars(oXML.responseBody)
'vairāk nevajadzēs
Set oXML = Nothing
'iespējams, vārds nebūs vispār atrasts
If InStr(1, sResponse, "images/not_found_text.gif") Then
sResponse = spText & ": " & vbCrLf & "Vārds nav atrasts"
End If
Dim iNum As Integer
iNum = InStr(1, sResponse, "<B>")
If Not iNum > 0 Then
iNum = 1
End If
sResponse = Mid(sResponse, iNum)
Dim sRemoves() As String
Dim i As Integer
sRemoves = Split("<b>,</b>,<i>,</i>,<strong>,</strong>," & _
"<u>,</u>,<script>,</script>,<p>,</p>,<i>," & _
"</i>,<big>,</big>,<small>,</small>,</body>,</html>", _
",", , vbTextCompare)
sResponse = Replace(sResponse, spText & "</B><SMALL><P>", _
spText & vbCrLf, , , vbTextCompare)
'izvācam visādus tagus
For i = 0 To UBound(sRemoves, 1)
sResponse = Replace(sResponse, sRemoves(i), "", , , vbTextCompare)
Next i
'atstarpes vajag
sResponse = Replace(sResponse, " ", " ")
sResponse = Replace(sResponse, "<br>", vbCrLf)
'atgriežamajai vērtībai novāc beigās enterus
Translate = TrimEnd(sResponse)
End Function
Function URLEncode(EncodeStr As String) As String
Dim i As Integer
Dim erg As String
erg = EncodeStr
' *** First replace '%' chr
erg = Replace(erg, "%", Chr(1))
' *** then '+' chr
erg = Replace(erg, "+", Chr(2))
For i = 0 To 255
Select Case i
' *** Allowed 'regular' characters
Case 37, 43, 48 To 57, 65 To 90, 97 To 122
Case 1 ' *** Replace original %
erg = Replace(erg, Chr(i), "%25")
Case 2 ' *** Replace original +
erg = Replace(erg, Chr(i), "%2B")
Case 32
erg = Replace(erg, Chr(i), "+")
Case 3 To 15
erg = Replace(erg, Chr(i), "%0" & Hex(i))
Case Else
erg = Replace(erg, Chr(i), "%" & Hex(i))
End Select
Next
URLEncode = erg
End Function
'no ResponseBody izveido normālu stringu
Function ToChars(ByVal opBody) As String
Dim i As Integer
Dim sChar As String
Dim sReturn As String
For i = 0 To Len(opBody) * 2 - 1
sChar = (Chr(opBody(i)))
sReturn = sReturn & sChar
Next i
ToChars = sReturn
End Function
'novāc lieko beigās - tabus, enterus
Function TrimEnd(ByVal spText As String) As String
Dim i As Integer
Dim sChar As String
For i = Len(spText) To 1 Step -1
sChar = Mid(spText, 1, 1)
If sChar <> vbCr And sChar <> vbLf And _
sChar <> " " And sChar <> vbTab Then
TrimEnd = Left(spText, i)
Exit Function
End If
Next i
End Function
Instrukcija tiem, kam šīs lietas nav diez ko pazīstamas:
- Iekopējam visu šeit redzamo kodu (to, kam kreisajā malā oranža svītra)
- Dodamies uz Wordu
- Spiežam uz klaviatūras Alt+F11
- Atrodam brīvu vietiņu, spiežam “Paste”
- Ejam uz menu: tools->references. Ieliekam ķeksīti pie “Microsoft XML, v. 6.0”
- Veram ciet šo papildus logu
- Izveicam augstāk minēto klaviatūras saīsnes veidošanu
Offtopic: Kas notika, ka rakstu atkārtoti publicē? Ja nemaldos, tad šis raksts tapa jau pirms pāris dienām.
P.S. Komentāru var dzēst un atbildēt uz e-pastu.
Muļķīgi eksperimenti ar “timestamp” mainīšanu.