プロが教えるわが家の防犯対策術!

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

A 回答 (3件)

ぁ。

正確なセル位置に拘らず、マウスカーソル位置基準で構わないなら、
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
    • good
    • 0

http://excelfactory.net/excelboard/excelvba/cfs. …
http://excelfactory.net/excelboard/excelvba/cfs. …

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

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

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

こちらのやり取りが参考になると思います


基本的にはセルの座標を取得してという感じです。

ユーザーフォーム表示位置について
http://hpcgi1.nifty.com/kenzo30/b_cbbs/cbbs.cgi? …
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A