HOME > エクセルVBA > サンプル > SendMessage

SendMessage


【ファイル名】SendMessage.xlsm
【バージョン】Ver 1.0.0.0
【作成日】2021年06月09日
【動作確認】Windows 10
【必要なソフト】Microsoft Excel 2010
【ダウンロード】SendMessage.zip
【説明】Windows APIのSendMessage 関数でクリップボードのテキストを貼り付けるサンプルです。
画面

クラス名は「Visual Studio」の「spyxx.exe」で調べました。下記はインストールのファイル名の例です。
C:\Program Files\Microsoft Visual Studio\2019\Community\Common7\Tools\spyxx.exe

【外部リンク】Windows > Apps > Win32 > API > Windows and Messages > Winuser.h >  FindWindowW functionFindWindowExW functionSendMessageW function

customUI14.xml
<?xml version="1.0" encoding="utf-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="onLoad">
  <ribbon startFromScratch="false">
    <tabs>
      <tab id="Tab1" label="サンプル" insertBeforeMso="TabHome" keytip="S">
        <group id="Group1" label="SendMessage">
          <button id="NotepadButton" label="メモ帳" keytip="S" size="large" imageMso="NewNotepadTool"
                  supertip="メモ帳を起動して、クリップボードのテキストを貼り付けます。" onAction="onAction" />
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>
このページの上

Module1
Option Explicit

Private Const WM_PASTE = &H302& ' 貼り付け

#If Win64 Then
  ' https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-findwindoww
  Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowW" (ByVal lpClassName As LongPtr, ByVal lpWindowName As LongPtr) As LongPtr

  ' https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-findwindowexw
  Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExW" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, _
                                                                                    ByVal lpsz1 As LongPtr, ByVal lpsz2 As LongPtr) As LongPtr

  ' https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-sendmessagew
  Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hwnd As LongPtr, ByVal wMsg As Long, _
                                                                                  ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
#Else
  Private Declare Function FindWindow Lib "user32" Alias "FindWindowW" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
  Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExW" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
                                                                            ByVal lpsz1 As Long, ByVal lpsz2 As Long) As Long
  Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hwnd As Long, ByVal wMsg As Long, _
                                                                          ByVal wParam As Long, ByVal lParam As Long) As Long
#End If

Private rbRibbonUI As IRibbonUI   ' リボン

Sub onLoad(ribbon As IRibbonUI) ' リボンの初期処理
  Set rbRibbonUI = ribbon ' リボンの表示を更新できるようにするためにリボンをセットする
  rbRibbonUI.Invalidate ' リボンの表示を更新します。
End Sub

Sub onAction(control As IRibbonControl) ' 各メニューの処理
  On Error GoTo ErrorHandler ' エラー処理ルーチン
  
  Select Case control.ID
    Case "NotepadButton"
      Call Notepad_Paste
    Case Else
      Beep ' 警告音
      MsgBox Prompt:=control.ID & "の処理がありません!", Buttons:=vbCritical + vbSystemModal, Title:="エラー"
      Exit Sub
  End Select
  
  Exit Sub
'
ErrorHandler: ' エラー処理ルーチン
  Beep ' 警告音
  MsgBox Prompt:="エラー番号:" & Err.Number & vbCrLf & Err.Description, Buttons:=vbCritical + vbSystemModal, Title:="エラー"
End Sub

Private Sub Notepad_Paste() ' メモ帳を起動して、クリップボードのテキストを貼り付ける
#If Win64 Then
  Dim hwnd As LongPtr
  Dim hEdit As LongPtr
#Else
  Dim hwnd As Long
  Dim hEdit As Long
#End If
Shell "Notepad.exe", vbNormalFocus ' メモ帳を起動する
  Application.Wait Now() + TimeValue("00:00:01") ' 1秒間待つ
  hwnd = FindWindow(StrPtr("NotePad"), StrPtr(vbNullString)) ' メモ帳のウィンドウ ハンドルを取得する
  hEdit = FindWindowEx(hwnd, 0, StrPtr("Edit"), StrPtr(vbNullString)) ' メモ帳のテキストボックスのハンドルを取得する
  Call SendMessage(hEdit, WM_PASTE, 0, 0) ' 「貼り付け」を実行する
End Sub
このページの上