-
Notifications
You must be signed in to change notification settings - Fork 1
/
mod_GetRectForExcel2007Plus.bas
68 lines (54 loc) · 2.16 KB
/
mod_GetRectForExcel2007Plus.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
Attribute VB_Name = "mod_GetRectForExcel2007Plus"
Private Type Rect
Left As Double
Top As Double
Right As Double
Bottom As Double
End Type
' ----------------------------------------
' Returns the cell coordinates in points relative to the screen
'
' @param {Object} Target the cell
' @return {Rect} the cell coordinates
' ----------------------------------------
Function GetRectForExcel2007Plus(ByVal Target As Range) As Rect
Dim Index As Integer
Dim Rect As Rect
With ActiveWindow
Set Target = Target.MergeArea
For Index = 1 To .Panes.Count
If Not Intersect(Target, .Panes(Index).VisibleRange) Is Nothing Then
With .Panes(Index)
Rect.Left = PixelsToPoints(.PointsToScreenPixelsX(Target.Left))
Rect.Top = PixelsToPoints(.PointsToScreenPixelsY(Target.Top))
End With
Rect.Right = Target.Width * .Zoom / 100 + Rect.Left
Rect.Bottom = Target.Height * .Zoom / 100 + Rect.Top
GetRectForExcel2007Plus = Rect
Exit Function
End If
Next
End With
End Function
' ----------------------------------------
' Converts pixels to points
' More info http://office.microsoft.com/en-us/excel-help/measurement-units-and-rulers-in-excel-HP001151724.aspx
' Important! 96 is DPI of system and may be different
'
' @param {Double} Pixels
' @return {Double} Points
' ----------------------------------------
Private Function PixelsToPoints(ByVal Pixels As Double) As Double
PixelsToPoints = Pixels / 96 * 72
End Function
' ----------------------------------------
' Converts points to pixels
' More info http://office.microsoft.com/en-us/excel-help/measurement-units-and-rulers-in-excel-HP001151724.aspx
' Important! 96 is DPI of system and may be different
'
' @param {Double} Points
' @return {Double} Pixels
' ----------------------------------------
Private Function PointsToPixels(ByVal Points As Double) As Double
PointsToPixels = Points / 72 * 96
End Function