给定 Excel 工作表上形状的 xy 坐标，这些坐标与工作表相关，如何将它们转换为屏幕的 xy 坐标？
问问题
2732 次
2 回答
0
使用Window.RangeFromPoint方法。有关更多详细信息，请参见此处。基本上，这显示了形状的 xy 坐标。你也可以使用Window.PointsToScreenPixelsX和Window.PointsToScreenPixelsY方法。
于 2013-09-06T21:00:34.420 回答
0
这几天让我很生气。我的解决方案使用 ActiveWindow.RangeFromPoint 方法将单元格归零。（编辑：我还包含了一些用于多显示器情况的代码。）
最后一部分通过 modPixelsToPoints 进行从点到像素的正式转换。一个很好的解决方案，可以让您的用户窗体在有问题的单元格上弹出。
对于 Micros0ft，这是一个很大的 FU，因为它首先没有在 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
于 2017-07-13T16:12:33.890 回答