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

SetCursorPos


【ファイル名】SetCursorPos.xlsm
【バージョン】Ver 1.0.0.0
【作成日】2021年05月13日
【動作確認】Windows 10
【必要なソフト】Microsoft Excel 2010
【ダウンロード】SetCursorPos.zip
【説明】Windows APIのSetCursorPos関数で、マウスのカーソルの位置を設定します。
メニュー

【外部リンク】Docs > Previous Versions >  POINT structure
【外部リンク】Windows > Apps > Win32 > API > Menus and Other Resources > Winuser.h >  SetCursorPosGetCursorPos

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="マウスのカーソルの位置の取得と設定">
          <button id="ShowFormButton" label="フォームを表示(&amp;S)" size="large" supertip="フォームを表示します。" onAction="onAction" />
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>
このページの上

UserForm1
Option Explicit

' https://docs.microsoft.com/en-us/previous-versions/dd162805(v=vs.85)
Private Type POINTAPI
  X As Long
  Y As Long
End Type

#If Win64 Then
  ' https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-setcursorpos
  Private Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
  
  ' https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-getcursorpos
  Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  
  ' https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-showcursor
  Private Declare PtrSafe Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long

#Else
  Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
  Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
#End If

' マウスのカーソルの表示・非表示を切り替える
' ShowCursor 関数は1つカウントアップか、カウントダウンするだけで、表示・非表示が切り替わるわけではありません。
Private Sub HideButton_Click()
  Dim cnt As Long
  
  Do
    cnt = ShowCursor(0) ' マウスのカーソルの非表示
  Loop Until cnt < 0
  DoEvents
  Application.Wait Now + TimeValue("00:00:02")
  
  Do
    cnt = ShowCursor(1)
  Loop Until cnt > 0 ' マウスのカーソルの表示
End Sub

' マウスのカーソルの位置を取得する
Private Sub GetButton_Click()
  Dim lpPoint As POINTAPI
  
  If GetCursorPos(lpPoint) = 0 Then
    MsgBox Prompt:="マウスのカーソルの位置を取得できません。", Buttons:=vbCritical + vbSystemModal, Title:="エラー"
  Else
    TextBoxX.Text = CStr(lpPoint.X)
    TextBoxY.Text = CStr(lpPoint.Y)
  End If
End Sub

' マウスのカーソルの位置を設定する
Private Sub SetButton_Click()
  Dim X As Long
  Dim Y As Long
  
  If Not IsNumeric(TextBoxX.Text) Then
    TextBoxX.SelStart = 0
    TextBoxX.SelLength = Len(TextBoxX.Text)
    TextBoxX.SetFocus
    MsgBox Prompt:="Xの位置が数字ではありません。", Buttons:=vbCritical + vbSystemModal, Title:="エラー"
    Exit Sub
  End If
  
  If Not IsNumeric(TextBoxY.Text) Then
    TextBoxY.SelStart = 0
    TextBoxY.SelLength = Len(TextBoxY.Text)
    TextBoxY.SetFocus
    MsgBox Prompt:="Yの位置が数字ではありません。", Buttons:=vbCritical + vbSystemModal, Title:="エラー"
    Exit Sub
  End If
  
  X = CLng(TextBoxX.Text)
  Y = CLng(TextBoxY.Text)
  
  If SetCursorPos(X, Y) = 0 Then
    MsgBox Prompt:="マウスのカーソルの位置を取得できません。", Buttons:=vbCritical + vbSystemModal, Title:="エラー"
  End If
End Sub
このページの上

Module1
Option Explicit

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 "ShowFormButton"
      UserForm1.Show vbModal
    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
このページの上