カスタム検索
Office関連

 

トップページ > Office関連 > キャレット位置にポップアップメニューを表示する(Word VBA)

 

Sponsored Links

キャレット位置にポップアップメニューを表示する(Word VBA)

キャレット位置(文字の挿入位置)にポップアップメニューを表示するマクロです。Word 2003以降で動作確認しました。

 

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"

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&)
  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

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:=msoControlButton)
      .Caption = "開く(&O)..."
      .OnAction = "ExecuteCommandBarID"
      .Parameter = 23
      .FaceId = 23
    End With
    With .Controls.Add(Type:=msoControlButton)
      .Caption = "閉じる(&C)"
      .OnAction = "ExecuteCommandBarID"
      .Parameter = 106
      .FaceId = 106
    End With
    With .Controls.Add(Type:=msoControlButton)
      .Caption = "名前を付けて保存(&A)..."
      .OnAction = "ExecuteCommandBarID"
      .Parameter = 748
      .FaceId = 748
    End With
    With .Controls.Add(Type:=msoControlButton)
      .BeginGroup = True
      .Caption = "形式を選択して貼り付け(&S)..."
      .OnAction = "ExecuteCommandBarID"
      .Parameter = 755
      .FaceId = 755
    End With
    With .Controls.Add(Type:=msoControlButton)
      .Caption = "テンプレートとアドイン(&I)..."
      .OnAction = "ExecuteCommandBarID"
      .Parameter = 751
      .FaceId = 751
    End With
    With .Controls.Add(Type:=msoControlButton)
      .Caption = "Visual Basic Editor(&V)"
      .OnAction = "ExecuteCommandBarID"
      .Parameter = 1695
      .FaceId = 1695
    End With
    With .Controls.Add(Type:=msoControlPopup)
      .BeginGroup = True
      .Caption = "マクロメニュー(&M)"
      With .Controls.Add(Type:=msoControlButton)
        .Caption = "マクロ1"
        .OnAction = "button_OnAction"
        .Parameter = "Hello."
        .FaceId = 190
      End With
      With .Controls.Add(Type:=msoControlButton)
        .Caption = "マクロ2"
        .OnAction = "button_OnAction"
        .FaceId = 190
      End With
    End With
    With .Controls.Add(Type:=msoControlPopup)
      .BeginGroup = True
      .Caption = "印刷メニュー(&P)"
      
      Dim itm As Object
      
      For Each itm In CreateObject("Shell.Application").Namespace(4).Items
        With .Controls.Add(Type:=msoControlButton)
          .Caption = itm.Name
          .OnAction = "btnPrint_OnAction"
          .Parameter = itm.Name
          .FaceId = 4
        End With
      Next
    End With
    With .Controls.Add(Type:=msoControlEdit)
      .BeginGroup = True
      .Caption = "文字入力"
      .OnAction = "edit_OnAction"
    End With
    With .Controls.Add(Type:=msoControlComboBox)
      .Caption = "サブメニュー"
      .OnAction = "comboBox_OnAction"
      .AddItem "ComboItem1"
      .AddItem "ComboItem2"
      .AddItem "ComboItem3"
    End With
    With .Controls.Add(Type:=msoControlDropdown, Temporary:=True)
      .Caption = "ドロップダウン"
      .OnAction = "dropdown_OnAction"
      .AddItem "DropItem1"
      .AddItem "DropItem2"
      .AddItem "DropItem3"
    End With
  End With
End Sub

Private Sub ExecuteCommandBarID()
  Application.CommandBars.FindControl(ID:=Application.CommandBars.ActionControl.Parameter).Execute
End Sub

Private Sub button_OnAction()
  Select Case Application.CommandBars.ActionControl.Caption
    Case "マクロ1"
      Macro1 Application.CommandBars.ActionControl.Parameter
    Case "マクロ2"
      Macro2
  End Select
End Sub

Private Sub Macro1(ByVal msg As String)
  MsgBox msg
End Sub

Private Sub Macro2()
  MsgBox Date
End Sub

Public Sub edit_OnAction()
'エディットボックスに入力した文字列を選択位置に挿入して太字に変更
  With Selection
    .Collapse wdCollapseEnd
    .InsertAfter Application.CommandBars.ActionControl.Text
    .Font.Bold = True
  End With
End Sub

Public Sub comboBox_OnAction()
  Selection.InsertAfter Application.CommandBars.ActionControl.Text
End Sub

Private Sub dropdown_OnAction()
  Selection.InsertBefore Application.CommandBars.ActionControl.Text
End Sub

Private Sub btnPrint_OnAction()
  Dim tmp As String
  
  tmp = Application.ActivePrinter
  Application.ActivePrinter = Application.CommandBars.ActionControl.Parameter
  Application.Dialogs(wdDialogFilePrint).Show
  Application.ActivePrinter = tmp
End Sub

 

メニューを表示するプロシージャは「ShowPopupCaretPos」で、「AddPopupMenu」でポップアップ表示するためのメニューを追加しています(それ以外のプロシージャはメニューから実行するプロシージャ)。

「AddPopupMenu」のコードを見てもらえれば分かるように、メニューではボタン(msoControlButton)やエディットボックス(msoControlEdit)等のコントロールを利用でき、さらにメニューを階層表示することも可能です(msoControlPopup)。

メニューからは自作のマクロはもちろん、ExecuteメソッドやExecuteMsoメソッドを使うことでWordに元々備わっている組み込みコマンドも実行することができ、コマンドにショートカットキーを設定することもできます(Captionプロパティに「&*」)。

 

Sponsored Links

 

上記マクロはツールバーやリボンから実行するのではなく、「ShowPopupCaretPos」プロシージャにショートカットキーを割り当てて使用することをお薦めします(割り当て方法はコチラやコチラのページを参照)。
ショートカットキーを割り当てることで、マウスを使用することなく任意のコマンドを実行でき、作業効率を上げることが可能になります。

トップページ > Office関連 > キャレット位置にポップアップメニューを表示する(Word VBA)