PDICをワンボタンで辞書引き

［TrimPaste,TrimPaste1,TrimPaste2,TrimPaste3をそれぞれ、キーボードに割り当ててください。］

SUB TrimPaste() DIM strTarget AS STRING DIM rngText AS Range Selection.StartOf Unit:=wdWord,Extend:=wdExtend Selection.EndOf Unit:=wdWord,Extend:=wdExtend strTarget =Selection.TEXT 'strTarget =Trim(Selection.Text) IF LEN(strTarget)<2 THEN MSGBOX ("Select a word from document.") END END IF IF RIGHT(strTarget,1)=""THEN Selection.MoveLeft Unit:=wdCharacter,Count:=1,Extend:=wdExtend END IF Selection.Copy END SUB SUB TrimPaste1() DIM strTarget AS STRING DIM rngText AS Range Selection.StartOf Unit:=wdWord,Extend:=wdExtend Selection.EndOf Unit:=wdWord,Extend:=wdExtend strTarget =Selection.TEXT 'strTarget =Trim(Selection.Text) IF LEN(strTarget)<3 THEN MSGBOX ("Select more than 3 character.") END END IF Selection.MoveLeft Unit:=wdCharacter,Count:=1,Extend:=wdExtend IF RIGHT(strTarget,1)=""THEN Selection.MoveLeft Unit:=wdCharacter,Count:=1,Extend:=wdExtend END IF Selection.Copy END SUB SUB TrimPaste2() DIM strTarget AS STRING DIM rngText AS Range Selection.StartOf Unit:=wdWord,Extend:=wdExtend Selection.EndOf Unit:=wdWord,Extend:=wdExtend strTarget =Selection.TEXT 'strTarget =Trim(Selection.Text) IF LEN(strTarget)<4 THEN MSGBOX ("Select more than 4 character.") END END IF Selection.MoveLeft Unit:=wdCharacter,Count:=2,Extend:=wdExtend IF RIGHT(strTarget,1)=""THEN Selection.MoveLeft Unit:=wdCharacter,Count:=1,Extend:=wdExtend END IF Selection.Copy END SUB SUB TrimPaste3() DIM strTarget AS STRING DIM rngText AS Range Selection.StartOf Unit:=wdWord,Extend:=wdExtend Selection.EndOf Unit:=wdWord,Extend:=wdExtend strTarget =Selection.TEXT 'strTarget =Trim(Selection.Text) IF LEN(strTarget)<5 THEN MSGBOX ("Select more than 5 character.") END END IF Selection.MoveLeft Unit:=wdCharacter,Count:=3,Extend:=wdExtend IF RIGHT(strTarget,1)=""THEN Selection.MoveLeft Unit:=wdCharacter,Count:=1,Extend:=wdExtend END IF Selection.Copy END SUB

クリップボードを経由したくない。（通常の，カットやコピーなどの編集作業でも作動するのは嫌だ）という方は，こちらを試してみてください。こちらは，PDIC専用で，DDEを使用しています。

SUB DDE_Search()
DIM strTarget AS STRING
DIM rngText AS Range
DIM chan AS LONG

Selection.StartOf Unit:=wdWord,Extend:=wdExtend
Selection.EndOf Unit:=wdWord,Extend:=wdExtend

strTarget =Selection.TEXT

IF LEN(strTarget)<2 THEN
MSGBOX ("Select a word from document.")
END
END IF

IF RIGHT(strTarget,1)=""THEN
Selection.MoveLeft Unit:=wdCharacter,Count:=1,Extend:=wdExtend

END IF

'Selection.Copy
'===Selection.Copyをこのように置き換え,または追加します。===
strTarget =Selection.TEXT
chan =DDEInitiate(App:="PDICW",Topic:="Dictionary")
DDEPoke Channel:=chan,Item:="Open",DATA:=""
DDEPoke Channel:=chan,Item:="PopupSearch",DATA:=strTarget
DDEPoke Channel:=chan,Item:="Close",DATA:=""
DDETerminate Channel:=chan
'=======================================================

END SUB