2013-08-07 3 views

답변

0

Window.RangeFromPoint 메서드를 사용하십시오. 자세한 내용은 here을 참조하십시오. 기본적으로 이것은 도형의 xy 좌표를 보여줍니다. 또한 Window.PointsToScreenPixelsXWindow.PointsToScreenPixelsY 방법을 사용할 수 있습니다.

0

이것은 과거 몇 일 동안 나를 격분 시켰습니다. 내 솔루션은 ActiveWindow.RangeFromPoint 메서드를 사용하여 셀을 0으로 만듭니다. (편집 : 다중 모니터 상황에 대한 코드도 포함 시켰습니다.)

마지막 부분은 modPixelsToPoints를 통해 점에서 픽셀로 형식 변환을 수행합니다. 문제의 셀을 통해 사용자 정의 폼을 팝업으로 표시하는 훌륭한 솔루션입니다.

그리고 여기에 그와 같은 함수/메소드를 처음부터 Range 객체에 포함시키지 않은 큰 F-U에서 Micros0ft가 있습니다.

또한 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입니다. 또, 코드는 당신이 변환을 수행 적절한 API 함수를 찾을 필요가 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 
관련 문제