option explicitprivate declare sub sleep lib "kernel32" (byval dwmilliseconds as long)
'為選擇的文字中的每個單詞注上音標
sub start()
on error resume next
'文件dim document as document
set document = activedocument
'各個索引
dim currentindex as long, endindex as long
currentindex = selection.start
endindex = selection.end
'正規表示式，用於搜尋單詞
dim regex as object
set regex = createobject("vbscript.regexp")
with regex
.multiline = true
.ignorecase = true
.pattern = "[a-z]+" '限制純英文
end with
'開始工作
do while currentindex < endindex
'獲取餘後要比較的文字
dim rng as range, text as string
set rng = document.range(currentindex, endindex)
text = rng.text
'匹配結果
dim matches as object
set matches = regex.execute(text)
if matches.count > 0 then
dim match as object
set match = matches(0)
'新單詞
dim word as string, wordstart as long, wordend as long
word = match.value
wordstart = currentindex + match.firstindex
wordend = wordstart + match.length
'查詢dim explanation as string
if (not lookup(word, explanation)) then
exit do
end if
'插入dim wordrng as range
set wordrng = document.range(wordstart, wordend)
wordrng.insertafter explanation
'設定樣式
dim explanationrng as range
set explanationrng = document.range(wordend, wordrng.end)
explanationrng.font.color = rgb(0, 0, 0)
explanationrng.highlightcolorindex = wdgray25
explanationrng.font.size = "8"
'設定音標字型
dim innerrng as range
set innerrng = document.range(wordend + 1, wordrng.end - 1)
innerrng.font.name = "kingsoft phonetic plain"
'準備下一次
currentindex = wordrng.end
endindex = endindex + len(explanation)
else
exit do
end if
loop
end sub
function lookup(word as string, byref explanation as string) as boolean
lookup = true
'確保有翻譯軟體
dim translator as string
translator = "金山詞霸2007（暫停取詞）"
if tasks.exists(translator) = false then'查詢詞典軟體是否在執行中（要以管理員身份執行此vba）
msgbox "請開啟金山詞霸2007並將其最小化至工作列中"
lookup = false
exit function '如果未在工作列中則關閉程式
end if
'查詢單詞
tasks(translator).windowstate = wdwindowstatenormal '正常視窗
tasks(translator).activate '啟用金山詞霸應用程式，此處填寫金山詞霸工作列的內容，如金山詞霸2007
sendkeys word, true '傳送單詞
'sleep 1000
sendkeys "", true '移動二次tab
'sleep 500
sendkeys "^a", true '複製
'sleep 500
sendkeys "^c", true '複製
sleep 800 '稍微停頓一下以等待以前的操作完成
'獲取查詢結果
dim mydata as msforms.dataobject
set mydata = new msforms.dataobject '引用dataobject(隨便拖乙個窗體控制項進來便可以引入其dll)
mydata.getfromclipboard '從剪貼簿複製資料到 dataobject
dim copytxt as string
copytxt = mydata.gettext(1) '獲得無格式文字
dim mystring() as string
mystring = vba.split(copytxt, vbcrlf) '返回乙個陣列
explanation = mystring(1) '取得陣列中的第二個值,也就是音標
'最小化翻譯軟體
tasks(translator).windowstate = wdwindowstateminimize
'成功lookup = true
end function
介面公升級版
介面公升級版 假設乙個介面由2w個子類實現它 假如在介面內加乙個方法 那麼按照定義就要在這所有的子類裡面都實現 所以我們引入新概念 介面裡可以定義普通方法 即這個普通方法可以不被實現 普通方法就要用default實現 介面還可以實現static方法 呼叫是直接由介面.方法名呼叫 inte ce im...
採藥公升級版
問題描述 辰辰是個天資聰穎的孩子，他的夢想是成為世界上最偉大的醫師。為此，他 想拜附近最有威望的醫師為師。醫師為了判斷他的資質，給他出了乙個難題。醫 師把他帶到乙個到處都是草藥的山洞裡對他說 孩子，這個山洞裡有一些不同 的草藥，採每一株都需要一些時間，每一株也有它自身的價值。我會給你一段時 間，在這...
約瑟夫問題公升級版
編號為1 n的n個人按順時針方向圍坐一圈，每人持有乙個密碼 正整數，可以自由輸入 開始人選乙個正整數作為報數上限值m，從第乙個人按順時針方向自1開始順序報數，報道m時停止報數。報m的人出列，將他的密碼作為新的m值，從他順時針方向上的下乙個人開始從1報數，如此下去，直至所有人全部出列為止。includ...