如何从PowerPoint中的LoadImage（）指向宽度和高度

Question

我在我的宏中使用LoadPicture方法来加载jpg图像。我想知道它的宽度和高度，但我得到的值没有用。我试图在一些论坛中找到解决方案，我看到了这个解决方案：

Set oBmp = LoadPicture(FileName)
Hght = ScaleX(oBmp.Width, vbHimetric, vbPixels)
Wdth = ScaleY(oBmp.Height, vbHimetric, vbPixels)

问题在于powerpoint ScaleX和ScaleY无法正常工作。至少在我的powerpoint中给出了编译错误：找不到方法或数据成员。

我也在尝试这种代码的和平：

Dim myPic As IPictureDisp

Set myPic = LoadPicture("C:\dink_template\dinkFile\sizeimage.jpg")
Hght = myPic.height
wid = myPic.width

我检查图像，他的像素大小是高度= 132px和宽度= 338px但是我得到高度= 2794和宽度7154

如何在powerpoint中使用ScaleX / ScaleY？或者如果我不能使用它们怎么能将值传递给像素？

Answer 1

这非常棘手。您从.Width和.Height属性获得的维度实际上是OLE_YSIZE_HMETRIC / OLE_XSIZE_HMETRIC，根据我的发现，这是一个代表0.01毫米的测量增量

我最初没有看到任何简单的解决方法，（公式或至少是一个有用的WinAPI函数）。

这适用于大多数具有正常/默认屏幕分辨率设置的用户

函数使用后期绑定/不需要对Publisher的引用，尽管库仍需要在用户的机器上可用。

Option Explicit
Sub Test()
    Dim filepath$
    filePath = "C:\image_file.JPG"
    MsgBox "Height = " & GetImageDimensions(filepath)(0) & vbNewLine & _
        "Width = " & GetImageDimensions(filepath)(1), vbOKOnly, "Dimensions"
End Sub

   Function GetImageDimensions(filepath) As Variant
    'Function returns an array of (Height, Width) from a specific image file path
    '
    Dim tmp(0 To 1) As Long
    Dim oPub As Object
    Set oPub = CreateObject("Publisher.Application")
    'returning picture.width in OLE_YSIZE_HIMETRIC/OLE_XSIZE_HIMETRIC
    ' these are representing 0.01 mm
    With LoadPicture(filepath)
    'Multiply by 0.01 to get dimension in millimeters, then
    ' use the MS Publisher functions to convert millimeters -> points -> pixels
        tmp(0) = 0.01 * oPub.PointsToPixels(oPub.MillimetersToPoints(.Height))
        tmp(1) = 0.01 * oPub.PointsToPixels(oPub.MillimetersToPoints(.Width))
    End With
    GetImageDimensions = tmp

    End Function

这是一个测试用例：

以下是结果：

评论更新

调试时我得到以下尺寸：

• .Height = 3493
• .Width = 8943

但是，您表示分别获得2794和7154。

我可以在更改屏幕分辨率时复制您的结果（例如，125％）。以下方法应解决这种差异。

尝试使用WinAPI（希望）说明我们得到的任何差异（像素大小，可能在您的计算机上有所不同，这可能会导致这种情况，尽管我希望Publisher功能会解释这个... ）

此功能与WinAPI调用应适用于所有用户，无论分辨率如何

Function GetImageDimensions2(filePath As String) As Variant
'Function returns an array of (Height, Width) from a specific image file path
Dim tmp(0 To 1) As Long
'returning picture.width in OLE_YSIZE_HIMETRIC/OLE_XSIZE_HIMETRIC
' these are representing 0.01 mm
With LoadPicture(filePath)
    tmp(0) = .Height / 2540 * (1440 / TwipsPerPixelY())
    tmp(1) = .Width / 2540 * (1440 / TwipsPerPixelX()) 
End With
GetImageDimensions2 = tmp
End Function

并在另一个模块中包含这些WinAPI调用：

Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
  ByVal hdc As Long) As Long
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, _
  ByVal nIndex As Long) As Long

Const HWND_DESKTOP As Long = 0
Const LOGPIXELSX As Long = 88
Const LOGPIXELSY As Long = 90

'--------------------------------------------------
Function TwipsPerPixelX() As Single
'--------------------------------------------------
'Returns the width of a pixel, in twips.
'--------------------------------------------------
  Dim lngDC As Long
  lngDC = GetDC(HWND_DESKTOP)
  TwipsPerPixelX = 1440& / GetDeviceCaps(lngDC, LOGPIXELSX)
  ReleaseDC HWND_DESKTOP, lngDC
End Function

'--------------------------------------------------
Function TwipsPerPixelY() As Single
'--------------------------------------------------
'Returns the height of a pixel, in twips.
'--------------------------------------------------
  Dim lngDC As Long
  lngDC = GetDC(HWND_DESKTOP)
  TwipsPerPixelY = 1440& / GetDeviceCaps(lngDC, LOGPIXELSY)
  ReleaseDC HWND_DESKTOP, lngDC
End Function