vba [vba] 현재셀(ActiveCell)의 Screen X/Y 좌표 알아내기
페이지 정보
본문
#If VBA7 Then
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As Long
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hdc As LongPtr) As Long
Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
#Else
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 GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
#End If
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type POINTAPI
x As Long
y As Long
End Type
Private Function ScreenDPI(bVert As Boolean) As Long
'in most cases this simply returns 96
#If VBA7 Then
Static lDPI(1) As LongPtr, lDC As LongPtr
#Else
Static lDPI(1) As Long, lDC As Long
#End If
If lDPI(0) = 0 Then
lDC = GetDC(0)
lDPI(0) = GetDeviceCaps(lDC, 88&) 'horz
lDPI(1) = GetDeviceCaps(lDC, 90&) 'vert
lDC = ReleaseDC(0, lDC)
End If
ScreenDPI = Val(lDPI(Abs(bVert)))
End Function
Private Function PTtoPX(Points As Single, bVert As Boolean) As Long
PTtoPX = Points * ScreenDPI(bVert) / 72
End Function
Sub GetRangeRect(ByVal rng As Range, ByRef rc As RECT)
Dim wnd As Window
Set wnd = rng.Parent.Parent.Windows(1)
With rng
rc.Left = PTtoPX(.Left * wnd.Zoom / 100, 0) _
+ wnd.PointsToScreenPixelsX(0)
rc.Top = PTtoPX(.Top * wnd.Zoom / 100, 1) _
+ wnd.PointsToScreenPixelsY(0)
rc.Right = PTtoPX(.Width * wnd.Zoom / 100, 0) _
+ rc.Left
rc.Bottom = PTtoPX(.Height * wnd.Zoom / 100, 1) _
+ rc.Top
End With
End Sub
Sub GetCoordinateXY()
Dim rc As RECT
On Error GoTo done
Call GetRangeRect(ActiveCell, rc)
Dim x As Long, y As Long
x = rc.Left
y = rc.Top
Debug.Print x, y
done:
End Sub
- 이전글[vb6.0/vba] [펌] Convert ASCII to UTF-8 20.02.12
- 다음글[vba] [nhn Q&A] [내공100점] 엑셀 지정위치에 사진 넣기... 사진대지 20.02.10
댓글목록
등록된 댓글이 없습니다.