將Excel工作表座標轉換爲屏幕座標

Question

給定Excel工作表上相對於工作表的形狀的xy座標，如何將它們轉換爲屏幕的xy座標？

Answer 1

使用Window.RangeFromPoint方法。有關更多詳細信息，請參見here。基本上這顯示形狀的xy座標。您也可以使用Window.PointsToScreenPixelsX和Window.PointsToScreenPixelsY方法。

Answer 2

這激怒了我過去幾天。我的解決方案使用ActiveWindow.RangeFromPoint方法在單元格中調入。 （編輯：我也包括一些代碼爲多監視器的情況。）

最後一部分通過modPixelsToPoints從點到像素進行正式轉換。一個很好的解決方案，讓您的用戶窗體在相關單元上彈出。

這裏是一個很大的F-U到Micros0ft，因爲它首先不在Range對象中包含這樣的函數/方法。

Function GetActiveCellXY() As POINTAPI 
     Dim target As POINTAPI 

     Dim startx As Single 
     Dim starty As Single 

     Dim currentx As Integer 
     Dim currenty As Integer 

     modMultiMonitor.Main 

     startx = modMultiMonitor.xStartingPoint 
     starty = modMultiMonitor.yStartingPoint 

    Restart: 

     If startx > 5000 Then ' If we hit this, we've missed the mark somehow 
      GetActiveCellXY.X = 0 
      GetActiveCellXY.Y = 0 
      Exit Function 
     End If 


     If Not ActiveWindow.RangeFromPoint(startx, starty) Is Nothing Then 
      currentx = ActiveWindow.RangeFromPoint(startx, starty).Column 
      currenty = ActiveWindow.RangeFromPoint(startx, starty).Row 
     Else 
      startx = startx + 10 
      starty = starty + 10 
      GoTo Restart 
     End If 

     If currentx < ActiveCell.Column Then 
      startx = startx + 5 
      GoTo Restart 
     End If 

     If currentx > ActiveCell.Column Then 
      startx = startx - 5 
      GoTo Restart 
     End If 

     If currenty < ActiveCell.Row Then 
      starty = starty + 5 
      GoTo Restart 
     End If 

     If currenty > ActiveCell.Row Then 
      starty = starty - 5 
      GoTo Restart 
     End If 



     'MsgBox startx & " " & starty 
     modPixelsToPoints.ConvertPixelsToPoints startx, starty 

     GetActiveCellXY.X = startx 
     GetActiveCellXY.Y = starty 
     Exit Function 

    HandleError:  ' Oh...I'll put in the On Error stuff someday 
      startx = startx + 10 
      starty = starty + 10 
      GoTo Restart 
    End Function 

還包括用於MultiMonitor確定的另一模塊（modMultiMonitor）。我無法將下面的代碼聲稱爲我自己的代碼。從https://answers.microsoft.com/en-us/msoffice/forum/msoffice_excel-msoffice_custom/detect-secondary-monitor-position/887b67de-8512-4883-81cb-52f9dea8226c?msgId=acf37bbe-a9b9-464c-b895-44a649aa602f明顯被盜。

謝謝，誰寫的！ :-D

Option Explicit 

    Public xStartingPoint As Long 
    Public yStartingPoint As Long 

    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (_ 
     ByVal lpClassName As String, ByVal lpWindowName As String) As Long 
    Private Const MONITORINFOF_PRIMARY = &H1 
    Private Const MONITOR_DEFAULTTONEAREST = &H2 
    Private Const MONITOR_DEFAULTTONULL = &H0 
    Private Const MONITOR_DEFAULTTOPRIMARY = &H1 
    Private Type RECT 
     Left As Long 
     Top As Long 
     Right As Long 
     Bottom As Long 
    End Type 
    Private Type MONITORINFO 
     cbSize As Long 
     rcMonitor As RECT 
     rcWork As RECT 
     dwFlags As Long 
    End Type 
    Private Type POINT 
     x As Long 
     y As Long 
    End Type 
    Private Declare Function GetMonitorInfo Lib "user32.dll" Alias "GetMonitorInfoA" (_ 
     ByVal hMonitor As Long, ByRef lpmi As MONITORINFO) As Long 
    Private Declare Function MonitorFromPoint Lib "user32.dll" (_ 
     ByVal x As Long, ByVal y As Long, ByVal dwFlags As Long) As Long 
    Private Declare Function MonitorFromRect Lib "user32.dll" (_ 
     ByRef lprc As RECT, ByVal dwFlags As Long) As Long 
    Private Declare Function MonitorFromWindow Lib "user32.dll" (_ 
     ByVal hWnd As Long, ByVal dwFlags As Long) As Long 
    Private Declare Function EnumDisplayMonitors Lib "user32.dll" (_ 
     ByVal hdc As Long, ByRef lprcClip As Any, ByVal lpfnEnum As Long, _ 
     ByVal dwData As Long) As Long 
    Private Declare Function GetWindowRect Lib "user32" (_ 
     ByVal hWnd As Long, lpRect As RECT) As Long 
    Dim hWnd As Long 
    Private Function MonitorEnumProc(ByVal hMonitor As Long, ByVal hdcMonitor As Long, _ 
     lprcMonitor As RECT, ByVal dwData As Long) As Long 
     Dim MI As MONITORINFO, R As RECT 
     Debug.Print "Moitor handle: " + CStr(hMonitor) 
     'initialize the MONITORINFO structure 
     MI.cbSize = Len(MI) 
     'Get the monitor information of the specified monitor 
     GetMonitorInfo hMonitor, MI 
     'write some information 
     Debug.Print "Monitor" & _ 
     " Left " & MI.rcMonitor.Left & _ 
     " Top " & MI.rcMonitor.Top & _ 
     " Size " & MI.rcMonitor.Right - MI.rcMonitor.Left & "x" & MI.rcMonitor.Bottom - MI _ 
     .rcMonitor.Top 
     Debug.Print "Primary monitor: " + CStr(CBool(MI.dwFlags = MONITORINFOF_PRIMARY)) 
     'check whether Form1 is located on this monitor 
     If MonitorFromWindow(hWnd, MONITOR_DEFAULTTONEAREST) = hMonitor Then 
     Debug.Print "hWnd is located on this monitor" 
     xStartingPoint = MI.rcMonitor.Left 
     yStartingPoint = MI.rcMonitor.Top 
     End If 
     'heck whether the point (0, 0) lies within the bounds of this monitor 
     If MonitorFromPoint(0, 0, MONITOR_DEFAULTTONEAREST) = hMonitor Then 
     Debug.Print "The point (0, 0) lies wihthin the range of this monitor..." 
     End If 
     'check whether Form1 is located on this monitor 
     GetWindowRect hWnd, R 
     If MonitorFromRect(R, MONITOR_DEFAULTTONEAREST) = hMonitor Then 
     Debug.Print "The rectangle of hWnd lies within this monitor" 
     End If 
     Debug.Print "" 
     'Continue enumeration 
     MonitorEnumProc = 1 
    End Function 
    Sub Main() 
     hWnd = FindWindow("XLMAIN", Application.Caption) 
     'start the enumeration 
     EnumDisplayMonitors ByVal 0&, ByVal 0&, AddressOf MonitorEnumProc, ByVal 0& 
    End Sub 

而這是modPixelsToPoints。再次，代碼被盜http://officeoneonline.com/vba/positioning_using_pixels.html

Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long 
    Private Declare Function ReleaseDC Lib "user32" (_ 
     ByVal hWnd As Long, _ 
     ByVal hDC As Long) As Long 
    Private Declare Function GetDeviceCaps Lib "gdi32" (_ 
     ByVal hDC As Long, _ 
     ByVal nIndex As Long) As Long 

    Const LOGPIXELSX = 88 
    Const LOGPIXELSY = 90 
    Const TWIPSPERINCH = 1440 

    Private Declare Function GetSystemMetrics Lib "user32" (_ 
     ByVal nIndex As Long) As Long 

    Private Const SM_CXFULLSCREEN = 16 
    Private Const SM_CYFULLSCREEN = 17 

    Sub ConvertPixelsToPoints(ByRef X As Single, ByRef Y As Single) 
     Dim hDC As Long 
     Dim RetVal As Long 
     Dim XPixelsPerInch As Long 
     Dim YPixelsPerInch As Long 

     hDC = GetDC(0) 
     XPixelsPerInch = GetDeviceCaps(hDC, LOGPIXELSX) 
     YPixelsPerInch = GetDeviceCaps(hDC, LOGPIXELSY) 
     RetVal = ReleaseDC(0, hDC) 
     X = X * TWIPSPERINCH/20/XPixelsPerInch 
     Y = Y * TWIPSPERINCH/20/YPixelsPerInch 
    End Sub 

    Sub Test() 
     Dim Wt As Single 
     Dim Ht As Single 

     Wt = GetSystemMetrics(SM_CXFULLSCREEN) 
     Ht = GetSystemMetrics(SM_CYFULLSCREEN) 
     With f_ListSearch 
      ConvertPixelsToPoints Wt, Ht 
      .Left = Wt - .Width 
      .Show vbModeless 
     End With 
    End Sub