Tra từ bamboo với Word và Excel

Cũng nghịch ngợm chút ít, thực ra là bắt đầu từ cái phần mềm gửi SMS bằng VB và VBA của mình, chợt nghĩ đến tại sao không làm một tiện ích tra từ ngay trong word với bamboo tra từ nhỉ. Ngoài ra cũng phải nhờ cái công cụ Bamboo cho firefox.
Cách tiếp cận thế này:
1. Chọn được từ cần tra.
2. Kết nối được với máy chủ của Bamboo
3. Gửi tham số tra từ tới máy chủ
Tham số có dạng
https://tratu.baamboo.com/dispatchaddon.php?dict=[Tên từ điển]&title=[Từ cần tra]&ver=0.9.14. và nhận kết quả, thể hiện qua một điều khiển Browser là xong.
Mình gửi tặng các bạn tập tin ví dụ với word nhé, Excel thì tương tự thôi.
Tuy nhiên cần lưu ý:
+ Trong VBA project, phải tham chiếu đến Microsoft Html Object library.
+ Đặt một nút bấm chẳng hạn Dictionary trong word và link đến wordlookup.
Caption của nút nên là Ditionar&y (để sau này chỉ cần nhấn Alt+Y là có kết quả).
Cách tra đơn giản, chọn một từ cần tra (nhấn đúp chuột lên từ đó), nhấn Alt+Y hoặc nhấn nút Dictionary vừa tạo là được. Kết quả sẽ tự hiển thị ra.
+ Tham số tra từ ở mục từ điển tương ứng như sau:
en_vn=Anh-Việt
vn_en=Việt-Anh
jp_vn=Nhật-Việt
vn_jp=Việt-Nhật
jp_en=Nhật-Anh
en_jp=Anh-Nhật
fr_vn=Pháp-Việt
vn_fr=Việt-Pháp
vn_vn=Việt-Việt
td_vt=Viết TắtChi tiết xin xem thêm trong file đính kèm nhé
=================================================
Giờ tớ giải thích cụ thể một chút về cách làm nhé:
A. Thêm 1 mô đun vào word, sau đó thêm cái ni, cốt để gọi ra cái form hiển thị kết quả.
Sub WorkLookup()
frmResults.Show
End Sub
B. Giờ vào làm form
+ Thêm Userform và đặt tên là frmResults
+ Thêm vào Toolbox một điều khiển Microsoft Web browser.
+ Lôi vào trên form cái điều khiển ý nhá, đặt tên là Browser chẳng hạn
Và sau đó thêm các đoạn code sau vào form là xong.
(À quên, còn phải thêm nút bấm trong word, liên kết với cái form này, có thể thêm tự động bằng cách thêm thực đơn như trong một số bài viết đã đề cập)

Option Explicit
Dim SysPath As String
Private HttpObject As Object

Private Const IF_FROM_CACHE = &H1000000
Private Const IF_NO_CACHE_WRITE = &H4000000
Private Const BUFFER_LEN = 256
Private Const VBA_AGENT = "VB Agent"

'//// Constant for WinHttp
Private Const WinHttpRequestOption_EnableHttpsToHttpRedirects = 12
Private Const WinHttpRequestOption_EnableRedirects = 6

Private Sub UserForm_Initialize()
Dim ServiceUrl As String
Dim myDic As String
Dim myWord As String
Dim myDoc As Object

' Initial the httpobject
Set HttpObject = CreateObject("WinHttp.WinHttpRequest.5.1")

SysPath = ThisDocument.Path
ServiceUrl = "https://tratu.baamboo.com/dispatchaddon.php?"
ServiceUrl = ServiceUrl & "dict=en_vn&title=" & RTrim(Selection.Text) & "&ver=0.9.1"
With Browser
.Navigate ServiceUrl
.Width = Me.Width – 15
.Height = Me.Height – 30
.Left = 5
.Top = 5
End With
On Error Resume Next
Set myDoc = Browser.Document
myDoc.body.innerHTML = GetUrlSource(ServiceUrl)
End Sub

Private Function GetUrlSourceNew(strUrl As String, _
Optional strParameter As String = "", _
Optional Redirect As Boolean = True, _
Optional ActionType As String = "POST", _
Optional ShouldBreakMessage As Boolean = False, _
Optional RefererText As String = "") As String

Dim retStr As String ' Variable to hold response data
With HttpObject
' turn on redirection method
.Option(WinHttpRequestOption_EnableHttpsToHttpRedirects) = Redirect
.Option(6) = True
' initialize the post action
If ActionType = "POST" Then
If ShouldBreakMessage Then
retStr = strUrl
Else
retStr = strUrl & "?" & strParameter ' for backward compatibility
End If
Else
retStr = strUrl
End If
.Open ActionType, retStr, False
' set request header for the connection
If ActionType = "POST" And ShouldBreakMessage Then
' set request header for the connection
'.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.1.6) Gecko/20070725 Firefox/2.0.0.6"
.SetRequestHeader "User-Agent", VBA_AGENT
.SetRequestHeader "Accept", "text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5"
.SetRequestHeader "Accept-Language", "en-us" ',en;q=0.5"
.SetRequestHeader "Accept-Encoding", "gzip,deflate"
.SetRequestHeader "Accept-Charset", "ISO-8859-1,utf-8" ';q=0.7,*;q=0.7"
.SetRequestHeader "Keep-Alive", "300"
.SetRequestHeader "Connection", "Keep-Alive"
If RefererText <> "" Then .SetRequestHeader "Referer", RefererText
.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"

'Encode parameter
strParameter = URLEncoding(strParameter) ' post body of the message
.SetRequestHeader "Content-Length", Len(strParameter)
.SetRequestHeader "Cache-Control", "no-cache"

'If strCookie <> "" Then .SetRequestHeader "Cookie", strCookie
.Send strParameter ' post body of the message
Else
.Send
End If
.WaitForResponse ' wait for server to response

retStr = .ResponseText ' ok receive it now
GetUrlSourceNew = retStr ' assign retrieved data to function
End With
End Function

Function URLEncoding(vstrIn) As String
Dim strReturn As String, i As Long, ThisChr As String, innerCode As Long, Hight8 As Long, Low8 As Long
strReturn = ""
For i = 1 To Len(vstrIn)
ThisChr = Mid(vstrIn, i, 1)
If Abs(Asc(ThisChr)) < &HFF Then
strReturn = strReturn & ThisChr
Else
innerCode = Asc(ThisChr)
If innerCode < 0 Then
innerCode = innerCode + &H10000
End If
Hight8 = (innerCode And &HFF00) &HFF
Low8 = innerCode And &HFF
strReturn = strReturn & "%" & Hex(Hight8) & "%" & Hex(Low8)
End If
Next
URLEncoding = strReturn
End Function

Function GetUrlSource(strUrl As String, Optional strParameter As String = "", Optional Redirect As Boolean = True, Optional ActionType As String = "POST", Optional ShouldBreakMessage As Boolean = False, Optional RefererText As String = "") As String
Dim retStr As String ' Variable to hold response data
On Error Resume Next
retStr = GetUrlSourceNew(strUrl, strParameter, Redirect, ActionType, ShouldBreakMessage, RefererText)
GetUrlSource = retStr
End Function

Private Sub UserForm_Terminate()
Set HttpObject = Nothing 'Release the session
End Sub

www.giaiphapexcel.com/diendan/threads/tra-t%E1%BB%AB-bamboo-v%E1%BB%9Bi-word-v%C3%A0-excel.17304/

Khóa học SprinGO phù hợp

Khóa học Power PI – Ứng dung trong Nhân sự

TỔNG QUAN KHÓA HỌC: POWER BI CHO NGÀNH NHÂN SỰ Khóa học Power BI cho Nhân sự được thiết kế dành riêng cho các...

Xem khóa học