お世話になります。 ”[96234] 図形のWindows座標位置は知ることができますか？”で以前質問させてい だき、藤代千尋さんにサンプルコードをいただき、やりたいことがほぼ実現できつつ あります。藤代千尋さん本当にありがとうございました。 ところがあと一歩のところで壁にぶつかっています。 ●問題 マウスの位置（Pixel)からEXCEL上のPoint位置を正確に知り、そこに図形を移動させたいのですが、倍率がZOOMが100%の場合は藤代千尋さんからいただいたPoint->Pixelに変換する式を逆にしたもので正確に算出できるのですが、ZOOMが100%以下の場合に正しく 変換できません。 そもそも、いただいた式は、Point->Pixelの変換式であるので、それを逆にしたから正確な値が得られるものかも、お恥ずかしいながらよくわかっておりません。（ZOOM100% のときにはOK） 尚、マウスが示す位置に図形を移動するには、SelectionChangeイベントでセルを特定してそこに設定することが一般的だと思いますが、ある事情があり、マウスをクリックすることなくマウスの位置に動的に追尾させる必要があります。（正確にはマウスのあとを図形が形を変えながら）　 ZOOMが100%、200%の場合は完璧に実現できているのですが、25%、75%のときには、Pixcel->Pointの変換がうまくいかず、期待する描画ができません。 ●質問 Q1.　画面上の任意の位置のPixcel座標からEXCELのpoint座標へ変換はできるのでしょうか。 Q2.　その変換は、表示倍率（ZOOM）に関係なく、または、調整することにより、正確に変換できるのでしょうか。 よろしくお願いいたします。 ++++++++++++++++++++ OS      ⇒Windows 2000 Version⇒Excel 2000 ++++++++++++++++++++

こんにちは。 試作レベルではありますが... Option Explicit 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 MoP As POINTAPI Private Const DPI As Double = 96 Private Const PPI As Double = 72 Sub shape_set() Dim f As Double Dim Lx As Single Dim Ty As Single Dim z As Long Dim r As Range Dim rev On Error GoTo ErrHandler Call GetCursorPos(MoP) With ActiveWindow z = .Zoom If z = 100 Then ReDim rev(1 To 2) rev(1) = 1 rev(2) = 1 Else Set r = .VisibleRange.Cells(.VisibleRange.Count) rev = rev_zoom(z, r) End If f = PPI * 100 / (DPI * z) Lx = (MoP.x - .PointsToScreenPixelsX(0)) * f * rev(1) Ty = (MoP.y - .PointsToScreenPixelsY(0)) * f * rev(2) End With With ActiveSheet.Shapes(1) .Left = Lx .Top = Ty End With ErrHandler: Set r = Nothing End Sub Function rev_zoom(ByVal z As Long, ByVal r As Range) Const p As Double = 0.5000001 Dim f As Double Dim ckL As Single Dim ckT As Single Dim x As Long Dim y As Long Dim i As Long Dim v(1 To 2) As Double With ActiveWindow x = .PointsToScreenPixelsX(0) y = .PointsToScreenPixelsY(0) f = DPI * z / (PPI * 100) For i = 1 To r.Column - 1 x = x + Int(Columns(i).Width * f + p) Next i For i = 1 To r.Row - 1 y = y + Int(Rows(i).Height * f + p) Next i f = PPI * 100 / (DPI * z) '1/t ckL = (x - .PointsToScreenPixelsX(0)) * f ckT = (y - .PointsToScreenPixelsY(0)) * f End With v(1) = r.Left / ckL v(2) = r.Top / ckT rev_zoom = v End Function 上記コードの基本部分は芳坂氏のホームページ http://hp.vector.co.jp/authors/VA016119/index.html （>My Personal.xls>CellScreenPos） ここで公開されているコードで勉強させて頂いたものです。 多分..ですけど、ZOOMや列幅行高によって補正しなければならないと思います。 さらにフォント設定も影響するような気がします。 また、上記はウィンドウ分割や枠固定には対応させていません。 （紹介ページは対応しています） それと、A1からVisibleRangeの最終セルまでの範囲で補正値を算出していますから 行位置が大きくなるとレスポンスが悪いです。 また、列幅行高が不揃いだと正確さは望めません。 （この辺でワタシはなげちゃいました...orz） （補正値を算出するのはもっと別のアプローチのほうが良いのかも^ ^;） 参考になれば幸いです。 この記事にはVBAのコードが含まれています。 緑の太文字→注釈 茶色の太文字→条件分岐 赤の太文字→ループ 青の太文字→その他

Nedさん、いただいたコードで勉強させていただきます。ほんとうにありがとうございました。

続き・関連があるなら、過去の質問の URL を書くこと。 http://excelfactory.net/excelboard/excelvba/excel.cgi?mode=all&namber=96234&rev=0 以下でいいはずです。試し方は以前と同じ。 Public Sub TestMousePoint() Dim xy As POINTAPI GetCursorPos xy Debug.Print ActiveWindow_ScreenPixelToPointX(xy.x), _ ActiveWindow_ScreenPixelToPointY(xy.y) Debug.Print ActiveCell.Left, _ ActiveCell.Top End Sub Public Function ActiveWindow_ScreenPixelToPointX(ByVal XPixel As Single) As Single With ActiveWindow ActiveWindow_ScreenPixelToPointX = (XPixel - .PointsToScreenPixelsX(0)) * (100 / .Zoom) / Screen_DPIX * 72 End With End Function Public Function ActiveWindow_ScreenPixelToPointY(ByVal YPixel As Single) As Single With ActiveWindow ActiveWindow_ScreenPixelToPointY = (YPixel - .PointsToScreenPixelsY(0)) * (100 / .Zoom) / Screen_DPIY * 72 End With End Function ところで、これらのコードを理解していますか？ 以前のシート上の位置（単位：ポイント）を、Windows 画面上の位置（単位：ピクセル）に変換するコードは次のようになっています。 Public Function ActiveWindow_PointToScreenPixelX(ByVal XPoint As Single) As Single With ActiveWindow ActiveWindow_PointToScreenPixelX = (.PointsToScreenPixelsX(0) + XPoint * (Screen_DPIX / 72) * (.Zoom / 100)) End With End Function XPoint が調べたいシート上のポイント位置です。 Windows 画面上のピクセル位置に変換するには、PointsToScreenPixels? を使うしかありませんが、これは A1 セルの左上の位置を、Windows 画面上のピクセル位置で返してくれます。 シート上の位置は、A1 セルの左上が原点なので、原点までは、Windows 画面上のピクセル位置で取得できると言うことです。 あとは、原点以降を、ポイント→ピクセル変換すればいいことになります。 ScreenPixel = PointsToScreenPixels? + ポイントは、1/72 インチです。 ピクセルが、1/x インチであるか分かれば変換可能となります。そしてこの 1/x インチは解像度のことで、普通は 96 dpi（ドット/インチ＝1/96インチ）です。 普通でないこともあるので、この値は、Screen_DPI? 関数で取得します。 すると、ピクセルは 　ピクセル /72 = インチ 　（72 ピクセルなら、ちょうど 1 インチ、36 ピクセルなら 1/2 インチ） 　インチ * Screen_DPI? = ピクセル 　（1 インチは 96 ピクセル、2 インチなら 192 ピクセル） となって、変換できます。 ScreenPixel = PointsToScreenPixels? + Point / 72 * Screen_DPI? もちろん、シートの倍率も考慮しなければなりません。 例えばシートが 200% と拡大させているとき、位置が 100 ポイントでも、ピクセルに変換すれば、それは 200 ポイントにあたる位置になるでしょう。なので、2 倍にしたい訳です。 Zoom には、200、100、50 などの値が入りますから、百分率にするため 100 で割ります。 ScreenPixel = PointsToScreenPixels? + Point / 72 * Screen_DPI? * Zoom /100 これで出来上がった式が、ちょっと括弧などで修飾されたものが、ActiveWindow_PointToScreenPixelX の内容です。 意味を理解していれば、これを逆にするのも別段難しいものではありません。(^^) この記事にはVBAのコードが含まれています。 緑の太文字→注釈 茶色の太文字→条件分岐 赤の太文字→ループ 青の太文字→その他

こんにちは。藤代千尋さん、いつも勉強させて頂いてます。ありがとうございますm(_ _)m 例えばzoom75%の時、 特に y 方向ですが、シート全体の行の高さが12.00ポイントなどの整数値だと良いのですが 12.75ポイントなどではズレが発生します。 行位置が下になるほどズレが大きくなります。 なんらかの補正値が必要になると思っているのですが。 #環境などによって違っていたらごめんなさい。 '編集追記 それからRockerさんへ >ある事情があり、マウスをクリックすることなくマウスの位置に動的に追尾させる必要があります。 >（正確にはマウスのあとを図形が形を変えながら） マウスに合わせて動くラインカーソルみたいなものでしょうか？ 具体的な使用シーンなどがわかると、別案や妥協案もあるかもしれません。 極端な話、コードによってzoomを限定してしまうとか...気が向いたらで結構ですので少し教えてください。

たしかにズレますね。(^^A) 行の高さが 12.75、倍率 75 % だと、1 行当たり 0.25 ずれます。ズレの量は 101 行目、201 行目で調べて同でした。 倍率 50 % だと、1 行当たり 0.75 ずれます。 倍率 25 % だと、1 行当たり -0.75 ずれます。 一貫性がないです。(^^;) 倍率 75 % 固定で、行の高さを変えていくと 10.50 0.50 11.25 -0.25 12.00 0.00 12.75 0.25 13.50 0.00 こっちも一貫性がないです。いや、何か法則があるのかも知れませんが、時間がないので調べられません。 計算式自体は合っていますし、計算の中で誤差が出る要素もないので Excel 側の問題だと思います。 しかし調べるのは大変なので、回避するのが一番だと思います。行高さが 12.75 でも、倍率が 100% ならズレませんので、マウス位置からポイント位置を計算する処理の前に、シートの倍率を 100% にしてしまいましょう。(^^)