推荐下载有道高中单词bin优秀word范文 11页.docx

推荐下载有道高中单词bin优秀word范文 11页.docx

《推荐下载有道高中单词bin优秀word范文 11页.docx》由会员分享，可在线阅读，更多相关《推荐下载有道高中单词bin优秀word范文 11页.docx（8页珍藏版）》请在冰豆网上搜索。

推荐下载有道高中单词bin优秀word范文11页

本文部分内容来自网络整理，本司不为其真实性负责，如有异议或侵权请及时联系，本司将立即删除！

==本文为word格式，下载后可方便编辑和修改！

==

有道高中单词bin

篇一：

有道单词本

'1.将以下程式码复制到ExcelVBA模组（Module）中

'

'2.在Excel工作表中AColumn输入要批量翻译的生词列表

'

'3.若要转出有道xml格式单词库文件，请执行xmlVocabulary，汇出的档案位置为Excel活页簿位置，档案名称为"工作表名称.xml"

'

'4.若要批量翻译直接写入Excel档，请执行xlsmVocabulary

'

'5.先以少量生词列表测试翻译速度，我自己1000个字大概花7~8分钟翻译

'

'6.若要现成的Excel档，请网搜"有道单词本.xlsm"

PrivateTypeCharacter

wordAsString

transAsString

phoneticAsString

tagsAsString

'progressAsInteger

EndType

'汇出有道xml格式单词库文件

SubxmlVocabulary（）

DimnewCharAsCharacter

DimRAsRange

DimRowAsRange

DimstrOutputAsString

DimarrBytes（）AsByte

newChar.tags=ActiveSheet.name

ActiveSheet.Names.Addname:

="NewWord",RefersTo:

="=OFFSET（$A$1,0,0,COUNTA（$A:

$A））"

SetR=ActiveSheet.Names（"NewWord"）.RefersToRange

strOutput=""

ForEachRowInR.Rows

newChar.word=Trim（Row

（1））

CallsearchWord（newChar.word,newChar.trans,newChar.phonetic）

strOutput=strOutput&vbCrLf&""

strOutput=strOutput&vbCrLf&""&newChar.word&""

strOutput=strOutput&vbCrLf&"

[CDATA["&newChar.trans&"]]>"

strOutput=strOutput&vbCrLf&"

[CDATA["&newChar.phonetic&"]]>"strOutput=strOutput&vbCrLf&""&newChar.tags&""

strOutput=strOutput&vbCrLf&"1"

strOutput=strOutput&vbCrLf&""

NextRow

strOutput=strOutput&vbCrLf&""

arrBytes=ChrW（&HFEFF）&strOutput'写入unicode文字码

OpenApplication.ActiveWorkbook.Path&"\"&newChar.tags&".xml"ForBinaryAs#1'立xml格式档案

Put#1,,arrBytes

Close#1

EndSub

'单词音译写入Excel档

SubxlsmVocabulary（）

DimnewCharAsCharacter

DimRAsRange

DimRowAsRange

DimrrAsInteger

strTags=ActiveSheet.name

ActiveSheet.Names.Addname:

="NewWord",RefersTo:

="=OFFSET（$A$1,0,0,COUNTA（$A:

$A））"

SetR=ActiveSheet.Names（"NewWord"）.RefersToRange

rr=0

ForEachRowInR.Rows

rr=rr+1

newChar.word=Trim（Row

（1））

建

CallsearchWord（newChar.word,newChar.trans,newChar.phonetic）

Worksheets（strTags）.Cells（rr,2）.Value=newChar.phonetic'撷取音标

Worksheets（strTags）.Cells（rr,3）.Value=newChar.trans'撷取翻译

NextRow

EndSub

SubsearchWord（tmpWordAsString,tmpTransAsString,tmpPhoneticAsString）

'/search?

q=单词&keyfrom=dict.index

DimXHAsObject

Dims（）AsString

Dimstr_tmpAsString

Dimstr_baseAsString

tmpTrans=""

tmpPhonetic=""

'开启网页

SetXH=CreateObject（"Microsoft.XMLHTTP"）

OnErrorResumeNext

XH.Open"get","/search?

q="&tmpWord&"&keyfrom=dict.index",FalseXH.send

OnErrorResumeNext

str_base=XH.responseText

XH.Close

SetXH=Nothing

str_base=Split（Split（XH.responseText,""）（0）,""）

（1）

'撷取音标

IfUBound（Split（str_base,"美"））=1Then

'美式音标

tmpPhonetic=Split（（Split（Split（str_base,"美"）

（1）,""）

（1））,""）（0）

OnErrorResumeNext

Else

tmpPhonetic=Split（（Split（str_base,""）

（1））,""）（0）OnErrorResumeNext

EndIf

'撷取中文翻译

str_tmp=Split（（Split（str_base,""）

（1））,"