この記事の中で少しだけご紹介したマクロの紹介です。
▼このマクロでできること
キャレット位置（カーソル位置）に表示されるポップアップメニューに特許番号を入力して[Enter] キーを押すと、エスパスネットのサイトで検索をして、書誌事項のページを表示します。
特許番号を選択した状態でこのマクロを実行すると、表示されるポップアップメニューにその選択した特許番号が自動で入力されるようになっています。
ポップアップメニューが表示されたら、[Tab] キーを一度押して、メニューをアクティブにします。
ここで、[Enter] キーを押すと、以下のようにエスパスネットの書誌事項が開きます。
▼マクロ解説
このマクロはいくつかのセクションにわかれています。
以下のマクロを1つの新しいモジュールにコピペしてください。
まず、Option Explicitですが、これは「変数の宣言を強制する『Option Explicit』の設定 」でご紹介したとおり、変数の宣言を強制するために記載されています。
黄緑色の部分は、前提条件をいろいろと定義をしていると思ってください。私はこのような記述はまだ書けませんので編集・改造はできませんが、ひとまずコピペなのでOKです。
赤文字の部分が、MyPopupMenuという名称でオリジナルのポップアップメニューを定義しています。マクロを実行する前にこのマクロを実行して、オリジナルのメニューを事前に作成します。
ちなみにこのマクロは、Private Subとして定義されていますので、通常のマクロダイアログ（Alt + F8で表示）のリストには表示されません。
VBE を開いてこのマクロにカーソルを置いてF5で実行してみてください。
黒文字の部分が、上記で定義したMyPopupMenuという名称のオリジナルポップアップメニューを表示させるためのマクロです。この「ShowPopupCaretPos」という名称のマクロをキーボードに登録しましょう。
私は、今回のマクロに向けて、'選択されているテキストを入力という部分を追記しました。
青文字の 部分が、MyPopupMenuという名称のオリジナルポップアップメニュー上のメニューを選択したときに実行されるマクロです。ここでエスパスネットの検索をしています。
説明の関係上、きぬあささんがサイトで掲載されているマクロ とは赤文字と黒文字の順序を変更しましたので、ご了承ください。
ブログ上では、わかりやすく説明できなくて申し訳ありませんが、新しいマクロの可能性に挑戦したい方、ぜひ使ってみてください。
▼マクロ
Option Explicit
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetFocus Lib "user32" () As Long
Private Declare Function GetCaretPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Const CommandBarName As String = "MyPopupMenu"
Private Sub AddPopupMenu()
'ポップアップメニュー追加
Application.CustomizationContext = ThisDocument '保存先をThisDocumentに指定
On Error Resume Next
Application.CommandBars(CommandBarName).Delete
On Error GoTo 0
With Application.CommandBars.Add(Name:=CommandBarName, Position:=msoBarPopup)
With .Controls.Add(Type:=msoControlEdit)
.BeginGroup = True
.Caption = "特許文献番号"
.OnAction = "espacenet"
.Width = 100
End With
End With
End Sub
Public Sub ShowPopupCaretPos()
'キャレット位置にポップアップメニュー表示
Dim hWwG As Long
Dim ClassName As String
Dim ClassBuf As String * 255
Dim p As POINTAPI
hWwG = GetFocus()
GetClassName hWwG, ClassBuf, Len(ClassBuf)
ClassName = Left$(ClassBuf, InStr(ClassBuf, vbNullChar) - 1&)
'選択されているテキストを入力
With Application.CommandBars(CommandBarName).Controls(1)
If Selection.Start = Selection.End Then
.Text = ""
Else
.Text = Selection.Text
End If
End With
If ClassName <> "_WwG" Then GoTo Err
GetCaretPos p
ClientToScreen hWwG, p
Application.CommandBars(CommandBarName).ShowPopup p.x, p.y
Exit Sub
Err:
MsgBox "処理が失敗しました。", vbCritical + vbSystemModal
End Sub
Public Sub espacenet()
'エディットボックスに入力した文献番号をエスパスネットで検索
Dim myLink As String
Dim myNumber As Variant
Dim myCC As String
Dim myNR As String
On Error GoTo ErrorHandler
With Application.CommandBars(CommandBarName).Controls(1)
If .Text = "" Then
GoTo End_Of_Proc
Else
myNumber = .Text
End If
End With
myCC = UCase(Left(myNumber, 2))
myNR = Mid(myNumber, 3)
myLink = "http://v3.espacenet.com/publicationDetails/biblio?DB&CC=" & myCC & "&NR=" & myNR
ActiveDocument.FollowHyperlink Address:=myLink
End_Of_Proc:
On Error GoTo 0
Exit Sub
ErrorHandler:
If Err = 4198 Then
MsgBox "入力ミスがあります。", vbExclamation, "エスパスネット"
End If
End Sub
▼関連記事
キャレット位置にポップアップメニューを表示する （サイト紹介）
エスパスネット関連情報 目次
マクロコードの登録方法
ツールバーのボタン登録