VBA中的尺寸单位

VBA里的尺寸单位很丰富，如Twip、Point、Pixel、Inch、Character、Millimeter、Centimeter等。不同的环境中使用的尺寸单位又不一样，例如Excel和Word一般使用Point，而Access多用Twip，API中用的尺寸单位则一般为Pixel，因此单位转换时会觉得有点混乱。这里介绍一下用得比较多的Twip，Point和Pixel。

Twip/Point是一个与屏幕无关的测量单位，使用这两个单位在打印时不需要考虑屏幕分辨率的问题。Pixel则是同屏幕分辨率有关的测量单位，屏幕上显示最小的一个点就是一个像素。

Twip、Point和Inch转换公式如下（1 Point等于20 Twip，1 Inch等于72 Point）：

Twip=1/20*Point=1/1440*Inch
Point=20*Twip=1/72*Inch

而Twip/Point与Pixel之间则要依据设备环境参数做转换，下面是一些转换的自定义函数。

Private Const HORZRES = 8
Private Const VERTRES = 10
Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Private Const TWIPSPERINCH = 1440
 
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, _
ByVal nIndex As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
ByVal hDC As Long) As Long
Function getDPI(bX As Boolean) As Integer		'获取屏幕分辨率
Dim hDC As Long, RetVal As Long
hDC = GetDC(0)
If bX = True Then
getDPI = GetDeviceCaps(hDC, LOGPIXELSX)
Else
getDPI = GetDeviceCaps(hDC, LOGPIXELSY)
End If
RetVal = ReleaseDC(0, hDC)
End Function
Function Pixel2TwipX(x As Long) As Long			'水平方向Pixel转Twip
Pixel2TwipX = (x / getDPI(True)) * TWIPSPERINCH
End Function
Function Pixel2TwipY(x As Long) As Long			'垂直方向Pixel转Twip
Pixel2TwipY = (x / getDPI(False)) * TWIPSPERINCH
End Function
Function Pixel2PointX(x As Long) As Long		'水平方向Pixel转Point
Pixel2PointX = Pixel2TwipX(x) / 20
End Function
Function Pixel2PointY(x As Long) As Long		'垂直方向Pixel转Point
Pixel2PointY = Pixel2TwipY(x) / 20
End Function
Function Twip2PixelX(x As Long) As Long			'水平方向Twip转Pixel
Twip2PixelX = x / TWIPSPERINCH * getDPI(True)
End Function
Function Twip2PixelY(x As Long) As Long			'垂直方向Twip转Pixel
Twip2PixelY = x / TWIPSPERINCH * getDPI(False)
End Function
Function Point2PixelX(x As Long) As Long		'水平方向Point转Pixel
Point2PixelX = Twip2PixelX(x * 20)
End Function
Function Point2PixelY(x As Long) As Long		'垂直方向Point转Pixel
Point2PixelY = Twip2PixelY(x * 20)
End Function
Function getScreenX() As Long					'获取屏幕宽
Dim hDC As Long, RetVal As Long
hDC = GetDC(0)
getScreenX = GetDeviceCaps(hDC, HORZRES)
RetVal = ReleaseDC(0, hDC)
End Function
Function getScreenY() As Long					'获取屏幕高
Dim hDC As Long, RetVal As Long
hDC = GetDC(0)
getScreenY = GetDeviceCaps(hDC, VERTRES)
RetVal = ReleaseDC(0, hDC)
End Function

获取屏幕分辨率的方法还有使用GetSystemMetrics API函数。例如下面的方法：

Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Sub GetScreenDimension()
MsgBox "屏幕宽度为: " & GetSystemMetrics(0) & vbCrLf & _
"屏幕高度为: " & GetSystemMetrics(1)
End Sub

Excel中也提供了一些方法进行尺寸转换，例如Application对象的CentimetersToPoints方法将厘米转换成Point，另一个InchesToPoints方法将Inch转换成Point。

比较奇怪的是Window对象的两个方法PointsToScreenPixelsX和PointsToScreenPixelsY。根据字面意义和帮助文件这两个方法表示将Point转换Pixel，而实际的结果并不正确。下面的代码是一个示例。

Sub Test()
Dim lSelWidth1 As Long
Dim lSelHeight1 As Long
Dim lSelWidth2 As Long
Dim lSelHeight2 As Long
 
With ActiveWindow
lSelWidth1 = .PointsToScreenPixelsX(.Selection.Width)
lSelHeight1 = .PointsToScreenPixelsY(.Selection.Height)
lSelWidth2 = Point2PixelX(.Selection.Width)
lSelHeight2 = Point2PixelY(.Selection.Height)
End With
MsgBox "ActiveWindow的PointsToScreenPixels方法计算结果:" & vbCrLf & vbTab & _
"宽度: " & lSelWidth1 & " | 高度: " & lSelHeight1 & vbCrLf & _
"自定义函数Point2Pixel方法计算结果:" & vbCrLf & vbTab & _
"宽度: " & lSelWidth2 & " | 高度: " & lSelHeight2
End Sub

这两个方法实际上接受的参数是以Pixel为单位，返回的值也是以Pixel为单位。传递的值为Excel中的像素坐标值（以A1单元格的左上角为原点），返回的结果表示传递的值在屏幕坐标（以屏幕左上角为原点）中的像素坐标值。PointsToScreenPixelsX(0)和PointsToScreenPixelsY(0)分别返回单元格A1的左上角在屏幕坐标（屏幕最左上角为[0,0]，向下和右为+）中的X轴和Y轴像素。所以应该是微软搞错了，但这两个方法应该还是很有用，只是比较让人迷惑而已。

更新(June 7, 2009)：多谢向東同学指出错误，计算Point转换Pixel时没有考虑到Point可能不是整数，导致计算错误。重新更改Point2PixelX，Point2PixelY，Pixel2PointX和Pixel2PointY函数如下：

Function Pixel2PointX(x As Long) As Double	'水平方向Pixel转Point
Pixel2PointX = Pixel2TwipX(x) / 20
End Function
Function Pixel2PointY(x As Long) As Double	'垂直方向Pixel转Point
Pixel2PointY = Pixel2TwipY(x) / 20
End Function
Function Point2PixelX(x As Double) As Long	'水平方向Point转Pixel
Point2PixelX = Twip2PixelX(x * 20)
End Function
Function Point2PixelY(x As Double) As Long	'垂直方向Point转Pixel
Point2PixelY = Twip2PixelY(x * 20)
End Function