none
左クリックした場所に画像を挿入したい RRS feed

  • 質問

  • お世話になっております。

    【OS】
    Windows10

    【実行したExcelのバージョン】
    Office 365 MSO(16.0.12527.20986) 64ビット

    【やりたいこと】
    コマンドボタン押下→シート上の任意の場所を左クリック→左クリックした場所に画像を挿入
    ・左クリックする場所は画像や図形の上の可能性もあります
    ・セルをクリックした場合もセルの左上でなく、クリックした座標が画像の左上に合うように挿入したいです

    【やりたいことを実現するために試したこと】
    コマンド実行時にループで左クリックを待つようにしました
    ' Windows API
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As LongPtr) As Long
    Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

    ' クリック座標の構造体
    Private Type POINTTYPE
        x As Long
        y As Long
    End Type

    ' コマンドボタン押下
    Public Sub InsertPicture()
        ' 記号選択時の右クリックを読み飛ばす
        GetAsyncKeyState (vbKeyLButton)

        'Escキーが押されたらループを抜ける
        Do Until GetAsyncKeyState(vbKeyEscape) <> 0
        
        'クリックされたときの処理
            If GetAsyncKeyState(vbKeyLButton) <> 0 Then
            
                ' 座標取得
                Dim point As POINTTYPE
                GetCursorPos point
                
                ' 画像挿入
                Dim path As String
                path = "C:\ExcelAddin\images\image1.png"
                With ActiveSheet.Pictures.Insert(path)
                    .Top = point.y
                    .Left = point.x
                End With

                Exit Do
            End If
        Loop
    End Sub

    【起きている問題】
    (1) A1セルの左上あたりをクリックすると、画像の左上がA13セルの中心にくるあたりに表示される
      →取得した座標はx=30, y=238でした
    (2) シート以外の場所(リボンの余白など)をクリックしても画像が挿入される

    【問題解決のために試したこと】
    https://okwave.jp/qa/q3709799.html
    こちらのサイトを参考にクライアント座標へ変換してみようと試みましたが、うまくいきませんでした

    上のコードに以下を追記しました
    ================================================
    ' WindowsAPI
    Private Declare PtrSafe Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As point) As Long
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal sClass As String, ByVal sTitle As String) As Long

    座標取得の下
    ' クライアント座標へ変換
    Dim hWndForm As Long
    hWndForm = FindWindow(vbNullString, "UserForm1")
    Dim ret As Boolean
    ret = ScreenToClient(hWndForm, point)
    ================================================

    こちらを追記すると関数呼び出し時にエラーになってしまいます

    エラーメッセージ
    コンパイルエラー:ByRef引数の型が一致しません。


    長くなってしまい申し訳ございません。
    足りない情報があれば追記いたしますので、お教えいただけると嬉しいです。
    よろしくお願いいたします。
    2020年9月8日 9:00

すべての返信

  • コンパイルエラー:ByRef引数の型が一致しません。

    エラーメッセージの通りです。
    ByRef な引数に渡す変数のデータ型が、関数宣言された引数の型と一致していないのが原因ですね。

    ' クリック座標の構造体
    Private Type POINTTYPE

    ここでは「POINTTYPE」ユーザー定義型を作成していますが、Declare ステートメントで使用しているのは、「As POINTAPI」や「As point」ですよね。型名が一致していないようです。

    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As LongPtr) As Long

    GetAsyncKeyState の第1引数は int 型なので、ByVal LongPtr ではなく ByVal Long です。
    戻り値は SHORT 型なので、As Long ではなく As Integer です。

    Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

    GetCursorPos の宣言ですが、提示されたコードでは POINTAPI という型は宣言されていないようです。
    第1引数は LPPOINT 型なので、ByRef POINTTYPE とするべきでしょう。
    戻り値は BOOL 型なので、As Long で問題ありません。


    Private Declare PtrSafe Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As point) As Long

    ScreenToClient の宣言ですが、point という型は宣言されていないように思えます。
    第1引数は HWND 型なので、As Long ではなく As LongPtr とします。
    第2引数は LPPOINT 型なので、GetCursorPos の時と同様、ByRef PONTTYPE にします。
    戻り値は BOOL 型なので、As Long で問題ありません。

    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal sClass As String, ByVal sTitle As String) As Long

    FindWindowA の第1引数と第2引数は LPCSTR 型なので、ByVal String で問題ありません。
    戻り値は HWND 型なので、As Long ではなく As LongPtr とします。

    2020年9月8日 10:31
  • やりたいことは、「スクリーン座標(カーソル位置)から、シート内の座標」だと思うので、FindWindow で "UserForm1" のハンドルでは間違っていると思います。
    これでは、スクリーン座標を "UserForm1" のクライアント座標に変換しているので、シート内の座標とはまったく違うものとなります。

    おそらくは、ActiveWindow.PointsToScreenPixelsX(0) と ActiveWindow.PointsToScreenPixelsY(0) を使って、セル A1 のスクリーン座標を得て、引き算することかな…?

    2020年9月8日 11:49
  • API構文の件が解決したとしても、シート上のセル位置の座標を正確に求めるのは困難ですよ。

    ウインドウのズーム値、分割、枠固定などが密接に絡んでくるため、一筋縄ではいきません。

    多少のずれが許容されるならそれっぽくできるかもですが、いずれにしても面倒だと思います。

    2020年9月8日 13:55
  • 魔界の仮面弁士さま

    ご回答ありがとうございます。
    一部APIは使用しないことにしたのですが、ご回答を参考に修正をしたらエラーが出なくなりました。
    初心者なので非常に助かりました。
    詳しく教えていただき本当にありがとうございました。
    2020年9月9日 2:26
  • Azuleanさま

    ご回答ありがとうございます。
    シート上の座標を取得したかったのでこちらの方法が正解でした。
    もともとあったものと組み合わせて理想の動きに近づきました。
    的確なご回答をいただきありがとうございました。
    2020年9月9日 2:29
  • minmin312さま

    ご回答ありがとうございます。
    座標を取得できるようになり、ご指摘いただいたところで悩んでいます。
    おっしゃる通り一筋縄ではいかなそうなので、ほかに手段がないか検討してみようと思います。
    ありがとうございました。
    2020年9月9日 2:33
  • 皆様ご回答いただきありがとうございました。

    minmin312さまのご回答の通りかなり難しそうな印象です。

    【やりたいこと】
    コマンドボタン押下→シート上の任意の場所を左クリック→左クリックした場所に画像を挿入
    ・左クリックする場所は画像や図形の上の可能性もあります
    ・セルをクリックした場合もセルの左上でなく、クリックした座標が画像の左上に合うように挿入したいです

    私が試した方法以外に、これを実現するための手段があったら教えていただけると嬉しいです。
    追加の質問になってしまい申し訳ございません。

    よろしくお願いいたします。
    2020年9月9日 2:37
  • 繰り返しになりますが、一発で“正確に”場所を特定する方法はないと思います。

    やっつけですが、なんとなく当たりをつけたところにとりあえず色付きオートシェイプを配置し、APIで画面座標上の色をチェックしてずれを補正する・・くらいしか思いつきません。

    2020年9月9日 12:10