ダブルクリックしたセルの近くにユーザーフォームを表示したい

質問

Worksheet_BeforeDoubleClick内でダブルクリックされたセルのすぐ近くに（例えば右側）ユーザーフォームを表示したいのですが、なかなかうまく行きません。
ネット上の情報を参考に、以下のようなコードを書いたのですが、画面右下に行くほど誤差が出てしまいます．．．座標系の考え方が間違っている？
どのような解像度のスクリーン環境でも、どのようなエクセルの画面サイズでも（全画面でも任意サイズでも）とにかくダブルクリックしたセルのすぐ近くに表示したいです。
よろしくお願いします。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　　Dim l_baseLeft As Long
　　Dim l_baseTop As Long
　　Dim l_selectLeft As Long
　　Dim l_selectTop As Long

　　Const DPI As Long = 96
　　Const PPI As Long = 72

　　l_baseLeft = ActiveWindow.PointsToScreenPixelsX(0)
　　l_baseTop = ActiveWindow.PointsToScreenPixelsY(0)
　　l_selectLeft = ((Selection.Left * DPI / PPI) * (ActiveWindow.Zoom / 100)) + l_baseLeft
　　l_selectTop = ((Selection.Top * DPI / PPI) * (ActiveWindow.Zoom / 100)) + l_baseTop

　　With UserForm1
　　　　.StartUpPosition = 0
　　　　.Top = l_selectTop
　　　　.Left = l_selectLeft
　　　　.Show
　　End With

回答No.3

end-u

ぁ。正確なセル位置に拘らず、マウスカーソル位置基準で構わないなら、
winAPI GetCursorPos関数を使って、比較的素直なアプローチができます。

'Sheet Module
Option Explicit

Private Declare Function GetDC Lib "user32.dll" ( _
　　　　　　　　　　　　　　　 ByVal hwnd As Long) As Long

Private Declare Function GetDeviceCaps Lib "gdi32.dll" ( _
　　　　　　　　　　　　　　　　　　　 ByVal hdc As Long, _
　　　　　　　　　　　　　　　　　　　 ByVal nIndex As Long) As Long

Private Declare Function ReleaseDC Lib "user32.dll" ( _
　　　　　　　　　　　　　　　　　 ByVal hwnd As Long, _
　　　　　　　　　　　　　　　　　 ByVal hdc As Long) As Long

Private Declare Function GetCursorPos Lib "user32.dll" ( _
　　　　　　　　　　　　　　　　　　　ByRef lpPoint As POINTAPI) As Long

Private Type POINTAPI
　　x As Long
　　y As Long
End Type

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　　Const LOGPIXELSX As Long = 88
　　Const LOGPIXELSY As Long = 90
　　Const mgn As Long = 10
　　Const ppi As Long = 72
　　Dim MoP　 As POINTAPI
　　Dim hdc　 As Long
　　Dim px　　As Long
　　Dim py　　As Long

　　On Error GoTo ErrHandler
　　Cancel = True
　　hdc = GetDC(0&)
　　px = GetDeviceCaps(hdc, LOGPIXELSX)
　　py = GetDeviceCaps(hdc, LOGPIXELSY)
　　ReleaseDC 0&, hdc
　　hdc = 0

　　Call GetCursorPos(MoP)
　　With UserForm1
　　　　.StartUpPosition = 0
　　　　.Left = MoP.x * ppi / px + mgn
　　　　.Top = MoP.y * ppi / py + mgn
　　　　.Show
　　End With

　　Exit Sub

ErrHandler:
　　If hdc <> 0 Then ReleaseDC 0&, hdc
　　MsgBox Err().Number & ":" & Err().Description
End Sub

回答No.2

end-u

http://excelfactory.net/excelboard/excelvba/cfs.cgi?word=96428&andor=and&logs=11.txt
http://excelfactory.net/excelboard/excelvba/cfs.cgi?word=98419&andor=and&logs=12.txt

PointsToScreenPixelsX/YとZoomを使って変換する方式は意外とややこしいです。
Zoomにはどうも誤差があるようだし、FreezePanesプロパティの状態も考慮しなければなりません。

http://hp.vector.co.jp/authors/VA016119/index.html
　└Excel 関係の仕事 ⇒
　　└Personal.xls
　　　└CellScreenPos

ここに CellScreenPos というFunctionが公開されてますから、参考にさせてもらうと良いですよ。

回答No.1

kmetu

こちらのやり取りが参考になると思います
基本的にはセルの座標を取得してという感じです。

ユーザーフォーム表示位置について
http://hpcgi1.nifty.com/kenzo30/b_cbbs/cbbs.cgi?mode=al2&namber=28718&rev=&no=0&P=R&KLOG=185